Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg	(revision 8865)
@@ -8,5 +8,5 @@
    rn_dx = 1000.0
    rn_dz = 1.0
-   nn_wad_test = 7
+   nn_wad_test = 1
 /
 !-----------------------------------------------------------------------
@@ -142,6 +142,6 @@
 &nambdy        !  unstructured open boundaries
 !-----------------------------------------------------------------------
-    ln_bdy         = .true.            
-    nb_bdy         = 1                    !  number of open boundary sets
+    ln_bdy         = .false.            
+    nb_bdy         = 0                    !  number of open boundary sets
     ln_coords_file = .false.              !  =T : read bdy coordinates from file
     cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
@@ -394,10 +394,10 @@
 !-----------------------------------------------------------------------
    ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
-   ln_dyn_trd  = .true.   ! (T) 3D momentum trend output
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
    ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
    ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet)
    ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
    ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
-   ln_tra_trd  = .true.    ! (T) 3D tracer trend output
+   ln_tra_trd  = .false.    ! (T) 3D tracer trend output
    ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
    nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
@@ -444,17 +444,16 @@
 &namwad  !   Wetting and drying
 !-----------------------------------------------------------------------
-   ln_wd             = .false.  ! T/F activation of NOC  wetting and drying scheme
+   ln_wd             = .false  ! T/F activation of NOC  wetting and drying scheme
    ln_rwd            = .true.   ! T/F activation of ROMS wetting and drying scheme
+   ln_rwd_bc         = .true.
    ln_rwd_rmp        = .true.   ! Turn on the limiter
-   ln_rwd_bc         = .true.   ! ROMS Baroclinic option
    ln_wd_diag        = .false.   ! T/F activation of diagnostics for ROMS wd scheme
-   rn_wdmin0         =  0.50     ! Rmp value for NOCL option
-   rn_wdmin1         =  0.150    ! Minimum wet depth on dried cells
-   rn_wdmin2         =  0.001    ! Tolerance of min wet depth on dried cells
-   rn_ssh_ref        =  3.0     ! reference level
+   rn_wdmin0         =  0.30     ! Minimum wet depth on dried cells
+   rn_wdmin1         =  0.2     ! Minimum wet depth on dried cells
+   rn_wdmin2         =  0.0001  ! Tolerance of min wet depth on dried cells
    rn_wdld           =  2.5     ! Land elevation below which wetting/drying is allowed
    nn_wdit           =   20     ! Max iterations for W/D limiter
    jn_wd_i           =  22      ! i index of diagnostics
    jn_wd_j           =   3      ! j index of diagnostics
-   jn_wd_k           =   3      ! k index of diagnostics
-/
+ 
+/
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/diawri.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/diawri.F90	(revision 8864)
+++ 	(revision )
@@ -1,1076 +1,0 @@
-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 dom_oce         ! ocean space and time domain
-   USE dynadv, ONLY: ln_dynadv_vec
-   USE zdf_oce         ! ocean vertical physics
-   USE ldftra          ! lateral physics: eddy diffusivity coef.
-   USE ldfdyn          ! lateral physics: eddy viscosity   coef.
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE icb_oce         ! Icebergs
-   USE icbdia          ! Iceberg budgets
-   USE sbcssr          ! restoring term toward SST/SSS climatology
-   USE phycst          ! physical constants
-   USE zdfmxl          ! mixed layer
-   USE dianam          ! build name of file (routine)
-   USE zdfddm          ! vertical  physics: double diffusion
-   USE diahth          ! thermocline diagnostics
-   USE wet_dry         ! wetting and drying
-   USE sbcwave         ! wave parameters
-   !
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE diatmb          ! Top,middle,bottom output
-   USE dia25h          ! 25h Mean output
-   USE iom
-   USE ioipsl
-
-#if defined key_lim2
-   USE limwri_2 
-#elif defined key_lim3
-   USE limwri 
-#endif
-   USE lib_mpp         ! MPP library
-   USE timing          ! preformance summary
-   USE diurnal_bulk    ! diurnal warm layer
-   USE cool_skin       ! Cool skin
-   USE wrk_nemo        ! working array
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dia_wri                 ! routines called by step.F90
-   PUBLIC   dia_wri_state
-   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
-
-   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_W, nz_W, nh_W                    ! grid_W file
-   INTEGER ::   ndex(1)                              ! ???
-   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
-   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
-   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
-
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: diawri.F90 7753 2017-03-03 11:46:59Z mocavero $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dia_wri_alloc()
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(2) :: ierr
-      !!----------------------------------------------------------------------
-      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)
-      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc )
-      !
-  END FUNCTION dia_wri_alloc
-
-   !!----------------------------------------------------------------------
-   !!   Default option                                   NetCDF output file
-   !!----------------------------------------------------------------------
-#if defined key_iomput
-   !!----------------------------------------------------------------------
-   !!   'key_iomput'                                        use IOM library
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE dia_wri( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  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                      ::   ji, jj, jk              ! dummy loop indices
-      INTEGER                      ::   jkbot                   !
-      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   ! 
-      !!
-      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
-      !!----------------------------------------------------------------------
-      ! 
-      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
-      ! 
-      CALL wrk_alloc( jpi , jpj      , z2d )
-      CALL wrk_alloc( jpi , jpj, jpk , z3d )
-      !
-      ! Output the initial state and forcings
-      IF( ninist == 1 ) THEN                       
-         CALL dia_wri_state( 'output.init', kt )
-         ninist = 0
-      ENDIF
-
-      ! Output of initial vertical scale factor
-      CALL iom_put("e3t_0", e3t_0(:,:,:) )
-      CALL iom_put("e3u_0", e3t_0(:,:,:) )
-      CALL iom_put("e3v_0", e3t_0(:,:,:) )
-      !
-      CALL iom_put( "e3t" , e3t_n(:,:,:) )
-      CALL iom_put( "e3u" , e3u_n(:,:,:) )
-      CALL iom_put( "e3v" , e3v_n(:,:,:) )
-      CALL iom_put( "e3w" , e3w_n(:,:,:) )
-      IF( iom_use("e3tdef") )   &
-         CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
-
-      CALL iom_put( "ssh" , sshn )                 ! sea surface height
-      IF( iom_use("wetdep") )   &                  ! wet depth
-         CALL iom_put( "wetdep" , ht_wd(:,:) + sshn(:,:) )
-      
-      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
-      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature
-      IF ( iom_use("sbt") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               jkbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
-            END DO
-         END DO
-         CALL iom_put( "sbt", z2d )                ! bottom temperature
-      ENDIF
-      
-      CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity
-      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity
-      IF ( iom_use("sbs") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               jkbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
-            END DO
-         END DO
-         CALL iom_put( "sbs", z2d )                ! bottom salinity
-      ENDIF
-
-      IF ( iom_use("taubot") ) THEN                ! bottom stress
-         z2d(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  &
-                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )      
-               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  &
-                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  ) 
-               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 
-               !
-            ENDDO
-         ENDDO
-         CALL lbc_lnk( z2d, 'T', 1. )
-         CALL iom_put( "taubot", z2d )           
-      ENDIF
-         
-      CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current
-      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current
-      IF ( iom_use("sbu") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               jkbot = mbku(ji,jj)
-               z2d(ji,jj) = un(ji,jj,jkbot)
-            END DO
-         END DO
-         CALL iom_put( "sbu", z2d )                ! bottom i-current
-      ENDIF
-      
-      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current
-      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current
-      IF ( iom_use("sbv") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               jkbot = mbkv(ji,jj)
-               z2d(ji,jj) = vn(ji,jj,jkbot)
-            END DO
-         END DO
-         CALL iom_put( "sbv", z2d )                ! bottom j-current
-      ENDIF
-
-      CALL iom_put( "woce", wn )                   ! vertical velocity
-      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
-         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
-         z2d(:,:) = rau0 * e1e2t(:,:)
-         DO jk = 1, jpk
-            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
-         END DO
-         CALL iom_put( "w_masstr" , z3d )  
-         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
-      ENDIF
-
-      CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef.
-      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef.
-      CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm)
-
-      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) )
-      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )
-
-      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
-         DO jj = 2, jpjm1                                    ! sst gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp  = tsn(ji,jj,1,jp_tem)
-               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
-               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
-               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
-                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'T', 1. )
-         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient
-         z2d(:,:) = SQRT( z2d(:,:) )
-         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
-      ENDIF
-         
-      ! clem: heat and salt content
-      IF( iom_use("heatc") ) THEN
-         z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2)
-      ENDIF
-
-      IF( iom_use("saltc") ) THEN
-         z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2)
-      ENDIF
-      !
-      IF ( iom_use("eken") ) THEN
-         rke(:,:,jk) = 0._wp                               !      kinetic energy 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
-                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    &
-                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  &
-                     &          *  zztmp 
-                  !
-                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    &
-                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  &
-                     &          *  zztmp 
-                  !
-                  rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy )
-                  !
-               ENDDO
-            ENDDO
-         ENDDO
-         CALL lbc_lnk( rke, 'T', 1. )
-         CALL iom_put( "eken", rke )           
-      ENDIF
-      !
-      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence
-      !
-      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
-         z3d(:,:,jpk) = 0.e0
-         z2d(:,:) = 0.e0
-         DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
-            z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
-         END DO
-         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
-         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum
-      ENDIF
-      
-      IF( iom_use("u_heattr") ) THEN
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'U', -1. )
-         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction
-      ENDIF
-
-      IF( iom_use("u_salttr") ) THEN
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'U', -1. )
-         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction
-      ENDIF
-
-      
-      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
-         z3d(:,:,jpk) = 0.e0
-         DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
-         END DO
-         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
-      ENDIF
-      
-      IF( iom_use("v_heattr") ) THEN
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'V', -1. )
-         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction
-      ENDIF
-
-      IF( iom_use("v_salttr") ) THEN
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'V', -1. )
-         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction
-      ENDIF
-
-      ! Vertical integral of temperature
-      IF( iom_use("tosmint") ) THEN
-         z2d(:,:)=0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'T', -1. )
-         CALL iom_put( "tosmint", z2d ) 
-      ENDIF
-
-      ! Vertical integral of salinity
-      IF( iom_use("somint") ) THEN
-         z2d(:,:)=0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( z2d, 'T', -1. )
-         CALL iom_put( "somint", z2d ) 
-      ENDIF
-
-      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2)
-      !
-      CALL wrk_dealloc( jpi , jpj      , z2d )
-      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
-      !
-      ! If we want tmb values 
-
-      IF (ln_diatmb) THEN
-         CALL dia_tmb 
-      ENDIF 
-      IF (ln_dia25h) THEN
-         CALL dia_25h( kt )
-      ENDIF 
-
-      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
-      !
-   END SUBROUTINE dia_wri
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                  use IOIPSL  library
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE dia_wri( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  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 nwrite time step, output the instantaneous or mean fields
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 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  ::   jn, ierror                               ! local integers
-      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
-      !
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
-      !!----------------------------------------------------------------------
-      ! 
-      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
-      !
-                             CALL wrk_alloc( jpi,jpj      , zw2d )
-      IF( .NOT.ln_linssh )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d )
-      !
-      ! Output the initial state and forcings
-      IF( ninist == 1 ) THEN                       
-         CALL dia_wri_state( 'output.init', kt )
-         ninist = 0
-      ENDIF
-      !
-      ! 0. Initialisation
-      ! -----------------
-
-      ! local variable for debugging
-      ll_print = .FALSE.
-      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 = nwrite * rdt
-      clop = "inst("//TRIM(clop)//")"
-#else
-      zsto=rdt
-      clop = "ave("//TRIM(clop)//")"
-#endif
-      zout = nwrite * rdt
-      zmax = ( nitend - nit000 + 1 ) * rdt
-
-      ! Define indices of the horizontal output zoom and vertical limit storage
-      iimi = 1      ;      iima = jpi
-      ijmi = 1      ;      ijma = jpj
-      ipk = jpk
-
-      ! define time axis
-      it = kt
-      itmod = kt - nit000 + 1
-
-
-      ! 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, rdt, zjulian )
-         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) 'Date 0 used :', 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, nwrite,' ' )
-            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, nwrite, '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, rdt, 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 )
-            IF( lk_mpp )   CALL mpp_sum( 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, nwrite, '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, rdt, 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, nwrite, '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, rdt, 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, nwrite, '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, rdt, 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" )
-
-
-         ! 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"      ,&  ! e3t_n
-            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
-            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n
-            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
-            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n
-            &             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 * tsn(:,:,1,jp_tem)
-            &                                                                  , "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 * tsn(:,:,1,jp_sal)
-            &                                                                  , "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_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( .NOT. ln_cpl ) 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
-
-         IF( ln_cpl .AND. nn_ice <= 1 ) 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
-
-         IF( ln_cpl .AND. nn_ice == 2 ) THEN
-            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
-               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
-               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         ENDIF
-
-         CALL histend( nid_T, snc4chunks=snc4set )
-
-         !                                                                                      !!! nid_U : 3D
-         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
-            &          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"    ,   &  ! vn
-            &          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"    ,   &  ! wn
-            &          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"  ,   &  ! avmu
-            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-
-         IF( lk_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, nwrite ) == 0 ) THEN 
-         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
-         WRITE(numout,*) '~~~~~~ '
-      ENDIF
-
-      IF( .NOT.ln_linssh ) THEN
-         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content
-         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content
-         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
-         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
-      ELSE
-         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature
-         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity
-         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature
-         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity
-      ENDIF
-      IF( .NOT.ln_linssh ) THEN
-         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
-         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness
-         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth
-         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
-      ENDIF
-      CALL histwrite( nid_T, "sossheig", it, sshn          , 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 (:,:) * tsn(:,:,1,jp_tem)
-         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
-         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal)
-         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_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( .NOT. ln_cpl ) 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
-         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
-         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
-      ENDIF
-      IF( ln_cpl .AND. nn_ice <= 1 ) 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
-         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * 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
-
-      IF( ln_cpl .AND. nn_ice == 2 ) THEN
-         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
-         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
-      ENDIF
-
-      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
-      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
-
-      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
-      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
-
-      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
-      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
-      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
-      IF( lk_zdfddm ) THEN
-         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
-      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 )
-      ENDIF
-      !
-                             CALL wrk_dealloc( jpi , jpj        , zw2d )
-      IF( .NOT.ln_linssh )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
-      !
-   END SUBROUTINE dia_wri
-#endif
-
-   SUBROUTINE dia_wri_state( cdfile_name, kt )
-      !!---------------------------------------------------------------------
-      !!                 ***  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
-      !!----------------------------------------------------------------------
-      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
-      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
-      !! 
-      CHARACTER (len=32) :: clname
-      CHARACTER (len=40) :: clop
-      INTEGER  ::   id_i , nz_i, nh_i       
-      INTEGER, DIMENSION(1) ::   idex             ! local workspace
-      REAL(wp) ::   zsto, zout, zmax, zjulian
-      !!----------------------------------------------------------------------
-      ! 
-      ! 0. Initialisation
-      ! -----------------
-
-      ! Define name, frequency of output and means
-      clname = cdfile_name
-      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-      zsto = rdt
-      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
-      zout = rdt
-      zmax = ( nitend - nit000 + 1 ) * rdt
-
-      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 :', clname, '.nc'
-
-
-      ! 1. Define NETCDF files and fields at beginning of first time step
-      ! -----------------------------------------------------------------
-
-      ! Compute julian date from starting date of the run
-      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis 
-      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
-      CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
-          1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
-      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
-          "m", jpk, gdept_1d, nz_i, "down")
-
-      ! Declare all the output fields as NetCDF variables
-
-      CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity
-         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature
-         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh
-         &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout )
-      CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current
-         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current
-         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
-      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
-         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
-         !
-      IF( ALLOCATED(ahtu) ) THEN
-         CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
-      ENDIF
-      IF( ALLOCATED(ahmt) ) THEN 
-         CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
-      ENDIF
-         !
-      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater 
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
-         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      IF( .NOT.ln_linssh ) THEN
-         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      ENDIF
-      !
-      IF( ln_wave .AND. ln_sdw ) THEN
-         CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      ENDIF
-
-#if defined key_lim2
-      CALL lim_wri_state_2( kt, id_i, nh_i )
-#elif defined key_lim3
-      CALL lim_wri_state( kt, id_i, nh_i )
-#else
-      CALL histend( id_i, snc4chunks=snc4set )
-#endif
-
-      ! 2. Start writing data
-      ! ---------------------
-      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 
-      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
-      ! donne le nombre d'elements, et idex la liste des indices a sortir
-      idex(1) = 1   ! init to avoid compil warning
-
-      ! Write all fields on T grid
-      CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature
-      CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity
-      CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height
-      CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity
-      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity
-      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity
-      !
-      IF( ALLOCATED(ahtu) ) THEN
-         CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point
-         CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point
-      ENDIF
-      IF( ALLOCATED(ahmt) ) THEN
-         CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point
-         CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point
-      ENDIF
-      !
-      CALL histwrite( id_i, "sowaflup", kt, emp - rnf        , jpi*jpj    , idex )    ! freshwater budget
-      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux
-      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux
-      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction
-      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
-      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
-
-      IF(  .NOT.ln_linssh  ) THEN             
-         CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth 
-         CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness  
-      END IF 
- 
-      IF( ln_wave .AND. ln_sdw ) THEN
-         CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity
-         CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity
-         CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity
-      ENDIF
-
-      ! 3. Close the file
-      ! -----------------
-      CALL histclo( id_i )
-#if ! defined key_iomput
-      IF( ninist /= 1  ) THEN
-         CALL histclo( nid_T )
-         CALL histclo( nid_U )
-         CALL histclo( nid_V )
-         CALL histclo( nid_W )
-      ENDIF
-#endif
-      ! 
-   END SUBROUTINE dia_wri_state
-
-   !!======================================================================
-END MODULE diawri
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90	(revision 8865)
@@ -674,7 +674,7 @@
       ENDIF
       !
-      IF( ln_wd  .or. ln_rwd ) THEN              ! wetting and drying domain
+      !IF( ln_wd  .or. ln_rwd ) THEN              ! wetting and drying domain
+      IF( ln_wd   ) THEN              ! wetting and drying domain
          CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
-         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
       ENDIF
       !
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domvvl.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domvvl.F90	(revision 8864)
+++ 	(revision )
@@ -1,1049 +1,0 @@
-MODULE domvvl
-   !!======================================================================
-   !!                       ***  MODULE domvvl   ***
-   !! Ocean : 
-   !!======================================================================
-   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code
-   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate
-   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
-   !!                                          vvl option includes z_star and z_tilde coordinates
-   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
-   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
-   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
-   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
-   !!   dom_vvl_rst      : read/write restart file
-   !!   dom_vvl_ctl      : Check the vvl options
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE phycst          ! physical constant
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! ocean surface boundary condition
-   USE wet_dry         ! wetting and drying
-   USE usrdef_istate   ! user defined initial state (wad only)
-   USE restart         ! ocean restart
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-   USE lib_mpp         ! distributed memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC  dom_vvl_init       ! called by domain.F90
-   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
-   PUBLIC  dom_vvl_sf_swp     ! called by step.F90
-   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90
-
-   !                                                      !!* Namelist nam_vvl
-   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
-   !                                                       ! conservation: not used yet
-   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
-   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
-   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
-   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
-   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 
-   !! $Id: domvvl.F90 7753 2017-03-03 11:46:59Z mocavero $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dom_vvl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION dom_vvl_alloc  ***
-      !!----------------------------------------------------------------------
-      IF( ln_vvl_zstar )   dom_vvl_alloc = 0
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-         ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   &
-            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   &
-            &      STAT = dom_vvl_alloc        )
-         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
-         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-         un_td = 0._wp
-         vn_td = 0._wp
-      ENDIF
-      IF( ln_vvl_ztilde ) THEN
-         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc )
-         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
-         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-      ENDIF
-      !
-   END FUNCTION dom_vvl_alloc
-
-
-   SUBROUTINE dom_vvl_init
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_vvl_init  ***
-      !!                   
-      !! ** Purpose :  Initialization of all scale factors, depths
-      !!               and water column heights
-      !!
-      !! ** Method  :  - use restart file and/or initialize
-      !!               - interpolate scale factors
-      !!
-      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
-      !!              - Regrid: e3(u/v)_n
-      !!                        e3(u/v)_b       
-      !!                        e3w_n           
-      !!                        e3(u/v)w_b      
-      !!                        e3(u/v)w_n      
-      !!                        gdept_n, gdepw_n and gde3w_n
-      !!              - h(t/u/v)_0
-      !!              - frq_rst_e3t and frq_rst_hdv
-      !!
-      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jk
-      INTEGER ::   ii0, ii1, ij0, ij1
-      REAL(wp)::   zcoef
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init')
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      !
-      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
-      !
-      !                    ! Allocate module arrays
-      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
-      !
-      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
-      CALL dom_vvl_rst( nit000, 'READ' )
-      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
-      !
-      !                    !== Set of all other vertical scale factors  ==!  (now and before)
-      !                                ! Horizontal interpolation of e3t
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
-      !                                ! Vertical interpolation of e3t,u,v 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
-      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
-      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
-      !
-      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
-      gdepw_n(:,:,1) = 0.0_wp
-      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
-      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
-      gdepw_b(:,:,1) = 0.0_wp
-      DO jk = 2, jpk                               ! vertical sum
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-               !                             ! 0.5 where jk = mikt     
-!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
-               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
-               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
-               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
-            END DO
-         END DO
-      END DO
-      !
-      !                    !==  thickness of the water column  !!   (ocean portion only)
-      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
-      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
-      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
-      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
-      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
-         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
-         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !
-      !                    !==  inverse of water column thickness   ==!   (u- and v- points)
-      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
-      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
-      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
-
-      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
-      IF( ln_vvl_ztilde ) THEN
-!!gm : idea: add here a READ in a file of custumized restoring frequency
-         !                                   ! Values in days provided via the namelist
-         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings
-         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
-         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
-         !
-         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
-            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
-            frq_rst_hdv(:,:) = 1._wp / rdt
-         ENDIF
-         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
-                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
-                     ! values outside the equatorial band and transition zone (ztilde)
-                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
-                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
-                     ! values inside the equatorial band (ztilde as zstar)
-                     frq_rst_e3t(ji,jj) =  0.0_wp
-                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt
-                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
-                     !                                      ! (linearly transition from z-tilde to z-star)
-                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
-                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                     frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                &
-                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   &
-                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                  ENDIF
-               END DO
-            END DO
-            IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
-               ii0 = 103   ;   ii1 = 111       
-               ij0 = 128   ;   ij1 = 135   ;   
-               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
-               frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt
-            ENDIF
-         ENDIF
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init')
-      !
-   END SUBROUTINE dom_vvl_init
-
-
-   SUBROUTINE dom_vvl_sf_nxt( kt, kcall ) 
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_vvl_sf_nxt  ***
-      !!                   
-      !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt,
-      !!                 tranxt and dynspg routines
-      !!
-      !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness.
-      !!               - z_tilde_case: after scale factor increment = 
-      !!                                    high frequency part of horizontal divergence
-      !!                                  + retsoring towards the background grid
-      !!                                  + thickness difusion
-      !!                               Then repartition of ssh INCREMENT proportionnaly
-      !!                               to the "baroclinic" level thickness.
-      !!
-      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case
-      !!               - tilde_e3t_a: after increment of vertical scale factor 
-      !!                              in z_tilde case
-      !!               - e3(t/u/v)_a
-      !!
-      !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in )           ::   kt      ! time step
-      INTEGER, INTENT( in ), OPTIONAL ::   kcall   ! optional argument indicating call sequence
-      !
-      INTEGER                ::   ji, jj, jk            ! dummy loop indices
-      INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers
-      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars
-      LOGICAL                ::   ll_do_bclinic         ! local logical
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt')
-      !
-      CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv )
-      CALL wrk_alloc( jpi,jpj,jpk,   ze3t )
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-      ENDIF
-
-      ll_do_bclinic = .TRUE.
-      IF( PRESENT(kcall) ) THEN
-         IF( kcall == 2 .AND. ln_vvl_ztilde )   ll_do_bclinic = .FALSE.
-      ENDIF
-
-      ! ******************************* !
-      ! After acale factors at t-points !
-      ! ******************************* !
-      !                                                ! --------------------------------------------- !
-      !                                                ! z_star coordinate and barotropic z-tilde part !
-      !                                                ! --------------------------------------------- !
-      !
-      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
-      DO jk = 1, jpkm1
-         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0)
-         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
-      END DO
-      !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
-         !                                                            ! ------baroclinic part------ !
-         ! I - initialization
-         ! ==================
-
-         ! 1 - barotropic divergence
-         ! -------------------------
-         zhdiv(:,:) = 0._wp
-         zht(:,:)   = 0._wp
-         DO jk = 1, jpkm1
-            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
-            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         END DO
-         zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) )
-
-         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only)
-         ! --------------------------------------------------
-         IF( ln_vvl_ztilde ) THEN
-            IF( kt > nit000 ) THEN
-               DO jk = 1, jpkm1
-                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   &
-                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )
-               END DO
-            ENDIF
-         ENDIF
-
-         ! II - after z_tilde increments of vertical scale factors
-         ! =======================================================
-         tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms
-
-         ! 1 - High frequency divergence term
-         ! ----------------------------------
-         IF( ln_vvl_ztilde ) THEN     ! z_tilde case
-            DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
-            END DO
-         ELSE                         ! layer case
-            DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
-            END DO
-         ENDIF
-
-         ! 2 - Restoring term (z-tilde case only)
-         ! ------------------
-         IF( ln_vvl_ztilde ) THEN
-            DO jk = 1, jpk
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk)
-            END DO
-         ENDIF
-
-         ! 3 - Thickness diffusion term
-         ! ----------------------------
-         zwu(:,:) = 0._wp
-         zwv(:,:) = 0._wp
-         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
-                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
-                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
-            DO ji = 1, jpi
-               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
-               vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
-            END DO
-         END DO
-         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
-                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
-         END DO
-         !                       ! d - thickness diffusion transport: boundary conditions
-         !                             (stored for tracer advction and continuity equation)
-         CALL lbc_lnk( un_td , 'U' , -1._wp)
-         CALL lbc_lnk( vn_td , 'V' , -1._wp)
-
-         ! 4 - Time stepping of baroclinic scale factors
-         ! ---------------------------------------------
-         ! Leapfrog time stepping
-         ! ~~~~~~~~~~~~~~~~~~~~~~
-         IF( neuler == 0 .AND. kt == nit000 ) THEN
-            z2dt =  rdt
-         ELSE
-            z2dt = 2.0_wp * rdt
-         ENDIF
-         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )
-         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
-
-         ! Maximum deformation control
-         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         ze3t(:,:,jpk) = 0._wp
-         DO jk = 1, jpkm1
-            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
-         END DO
-         z_tmax = MAXVAL( ze3t(:,:,:) )
-         IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain
-         z_tmin = MINVAL( ze3t(:,:,:) )
-         IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain
-         ! - ML - test: for the moment, stop simulation for too large e3_t variations
-         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN
-            IF( lk_mpp ) THEN
-               CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) )
-               CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3) )
-            ELSE
-               ijk_max = MAXLOC( ze3t(:,:,:) )
-               ijk_max(1) = ijk_max(1) + nimpp - 1
-               ijk_max(2) = ijk_max(2) + njmpp - 1
-               ijk_min = MINLOC( ze3t(:,:,:) )
-               ijk_min(1) = ijk_min(1) + nimpp - 1
-               ijk_min(2) = ijk_min(2) + njmpp - 1
-            ENDIF
-            IF (lwp) THEN
-               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax
-               WRITE(numout, *) 'at i, j, k=', ijk_max
-               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin
-               WRITE(numout, *) 'at i, j, k=', ijk_min            
-               CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')
-            ENDIF
-         ENDIF
-         ! - ML - end test
-         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below
-         tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) )
-         tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) )
-
-         !
-         ! "tilda" change in the after scale factor
-         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         DO jk = 1, jpkm1
-            dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk)
-         END DO
-         ! III - Barotropic repartition of the sea surface height over the baroclinic profile
-         ! ==================================================================================
-         ! add ( ssh increment + "baroclinicity error" ) proportionly to e3t(n)
-         ! - ML - baroclinicity error should be better treated in the future
-         !        i.e. locally and not spread over the water column.
-         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible)
-         zht(:,:) = 0.
-         DO jk = 1, jpkm1
-            zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
-         DO jk = 1, jpkm1
-            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
-         END DO
-
-      ENDIF
-
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer )  THEN   ! z_tilde or layer coordinate !
-      !                                           ! ---baroclinic part--------- !
-         DO jk = 1, jpkm1
-            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
-         END DO
-      ENDIF
-
-      IF( ln_vvl_dbg .AND. .NOT. ll_do_bclinic ) THEN   ! - ML - test: control prints for debuging
-         !
-         IF( lwp ) WRITE(numout, *) 'kt =', kt
-         IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-            z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) )
-            IF( lk_mpp ) CALL mpp_max( z_tmax )                             ! max over the global domain
-            IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax
-         END IF
-         !
-         zht(:,:) = 0.0_wp
-         DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax
-         !
-         zht(:,:) = 0.0_wp
-         DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax
-         !
-         zht(:,:) = 0.0_wp
-         DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshn(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssha(:,:) ) )
-         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax
-      END IF
-
-      ! *********************************** !
-      ! After scale factors at u- v- points !
-      ! *********************************** !
-
-      CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' )
-
-      ! *********************************** !
-      ! After depths at u- v points         !
-      ! *********************************** !
-
-      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1)
-      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk)
-         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !                                        ! Inverse of the local depth
-!!gm BUG ?  don't understand the use of umask_i here .....
-      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) )
-      !
-      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv )
-      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt')
-      !
-   END SUBROUTINE dom_vvl_sf_nxt
-
-
-   SUBROUTINE dom_vvl_sf_swp( kt )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_vvl_sf_swp  ***
-      !!                   
-      !! ** Purpose :  compute time filter and swap of scale factors 
-      !!               compute all depths and related variables for next time step
-      !!               write outputs and restart file
-      !!
-      !! ** Method  :  - swap of e3t with trick for volume/tracer conservation
-      !!               - reconstruct scale factor at other grid points (interpolate)
-      !!               - recompute depths and water height fields
-      !!
-      !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step
-      !!               - Recompute:
-      !!                    e3(u/v)_b       
-      !!                    e3w_n           
-      !!                    e3(u/v)w_b      
-      !!                    e3(u/v)w_n      
-      !!                    gdept_n, gdepw_n  and gde3w_n
-      !!                    h(u/v) and h(u/v)r
-      !!
-      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
-      !!              Leclair, M., and G. Madec, 2011, Ocean Modelling.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! time step
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zcoef        ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp')
-      !
-      IF( kt == nit000 )   THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_swp : - time filter and swap of scale factors'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   - interpolate scale factors and compute depths for next time step'
-      ENDIF
-      !
-      ! Time filter and swap of scale factors
-      ! =====================================
-      ! - ML - e3(t/u/v)_b are allready computed in dynnxt.
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-         IF( neuler == 0 .AND. kt == nit000 ) THEN
-            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:)
-         ELSE
-            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
-            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )
-         ENDIF
-         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)
-      ENDIF
-      gdept_b(:,:,:) = gdept_n(:,:,:)
-      gdepw_b(:,:,:) = gdepw_n(:,:,:)
-
-      e3t_n(:,:,:) = e3t_a(:,:,:)
-      e3u_n(:,:,:) = e3u_a(:,:,:)
-      e3v_n(:,:,:) = e3v_a(:,:,:)
-
-      ! Compute all missing vertical scale factor and depths
-      ! ====================================================
-      ! Horizontal scale factor interpolations
-      ! --------------------------------------
-      ! - ML - e3u_b and e3v_b are allready computed in dynnxt
-      ! - JC - hu_b, hv_b, hur_b, hvr_b also
-      
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F'  )
-      
-      ! Vertical scale factor interpolations
-      CALL dom_vvl_interpol( e3t_n(:,:,:),  e3w_n(:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-      CALL dom_vvl_interpol( e3t_b(:,:,:),  e3w_b(:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
-
-      ! t- and w- points depth (set the isf depth as it is in the initial step)
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-      gdepw_n(:,:,1) = 0.0_wp
-      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
-      DO jk = 2, jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-                                                                 ! 1 for jk = mikt
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =    zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk) )  &
-                   &             + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk) ) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
-            END DO
-         END DO
-      END DO
-
-      ! Local depth and Inverse of the local depth of the water
-      ! -------------------------------------------------------
-      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:)
-      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:)
-      !
-      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)
-      DO jk = 2, jpkm1
-         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-      END DO
-
-      ! write restart file
-      ! ==================
-      IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp')
-      !
-   END SUBROUTINE dom_vvl_sf_swp
-
-
-   SUBROUTINE dom_vvl_interpol( pe3_in, pe3_out, pout )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_vvl__interpol  ***
-      !!
-      !! ** Purpose :   interpolate scale factors from one grid point to another
-      !!
-      !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0)
-      !!                - horizontal interpolation: grid cell surface averaging
-      !!                - vertical interpolation: simple averaging
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
-      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
-      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !
-      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
-      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
-      !
-      IF(ln_wd) THEN
-        zlnwd = 1.0_wp
-      ELSE
-        zlnwd = 0.0_wp
-      END IF
-      !
-      SELECT CASE ( pout )    !==  type of interpolation  ==!
-         !
-      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
-                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
-         !
-      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
-                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
-         !
-      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
-                     &                       *    r1_e1e2f(ji,jj)                                                  &
-                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
-         !
-      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
-         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
-!!gm BUG? use here wmask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
-               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
-               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
-               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
-         END DO
-         !
-      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
-!!gm BUG? use here wumask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
-               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
-               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
-               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
-         END DO
-         !
-      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
-!!gm BUG? use here wvmask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
-               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
-               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
-               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
-         END DO
-      END SELECT
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol')
-      !
-   END SUBROUTINE dom_vvl_interpol
-
-
-   SUBROUTINE dom_vvl_rst( kt, cdrw )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE dom_vvl_rst  ***
-      !!                     
-      !! ** Purpose :   Read or write VVL file in restart file
-      !!
-      !! ** Method  :   use of IOM library
-      !!                if the restart does not contain vertical scale factors,
-      !!                they are set to the _0 values
-      !!                if the restart does not contain vertical scale factors increments (z_tilde),
-      !!                they are set to 0.
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
-      !
-      INTEGER ::   ji, jj, jk
-      INTEGER ::   id1, id2, id3, id4, id5     ! local integers
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_rst')
-      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
-         !                                   ! ===============
-         IF( ln_rstart ) THEN                   !* Read the restart file
-            CALL rst_read_open                  !  open the restart file if necessary
-            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
-            !
-            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. )
-            id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. )
-            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. )
-            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
-            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
-            !                             ! --------- !
-            !                             ! all cases !
-            !                             ! --------- !
-            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
-               ! needed to restart if land processor not computed 
-               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files'
-               WHERE ( tmask(:,:,:) == 0.0_wp ) 
-                  e3t_n(:,:,:) = e3t_0(:,:,:)
-                  e3t_b(:,:,:) = e3t_0(:,:,:)
-               END WHERE
-               IF( neuler == 0 ) THEN
-                  e3t_b(:,:,:) = e3t_n(:,:,:)
-               ENDIF
-            ELSE IF( id1 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files'
-               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
-               e3t_n(:,:,:) = e3t_b(:,:,:)
-               neuler = 0
-            ELSE IF( id2 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files'
-               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-               neuler = 0
-            ELSE
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file'
-               IF(lwp) write(numout,*) 'Compute scale factor from sshn'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
-               DO jk = 1, jpk
-                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
-                      &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-                      &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
-               END DO
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-               neuler = 0
-            ENDIF
-            !                             ! ----------- !
-            IF( ln_vvl_zstar ) THEN       ! z_star case !
-               !                          ! ----------- !
-               IF( MIN( id3, id4 ) > 0 ) THEN
-                  CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' )
-               ENDIF
-               !                          ! ----------------------- !
-            ELSE                          ! z_tilde and layer cases !
-               !                          ! ----------------------- !
-               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist
-                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )
-                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )
-               ELSE                            ! one at least array is missing
-                  tilde_e3t_b(:,:,:) = 0.0_wp
-                  tilde_e3t_n(:,:,:) = 0.0_wp
-               ENDIF
-               !                          ! ------------ !
-               IF( ln_vvl_ztilde ) THEN   ! z_tilde case !
-                  !                       ! ------------ !
-                  IF( id5 > 0 ) THEN  ! required array exists
-                     CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) )
-                  ELSE                ! array is missing
-                     hdiv_lf(:,:,:) = 0.0_wp
-                  ENDIF
-               ENDIF
-            ENDIF
-            !
-         ELSE                                   !* Initialize at "rest"
-            !
-
-! MJB ln_rwd edits start here - these are essential 
-
-            IF( (ln_wd .OR. ln_rwd)) THEN 
-
-              ! Wetting and drying test case
-               IF( cn_cfg == 'wad' ) THEN
-              CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )
-                  tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
-                  sshn (:,:)     = sshb(:,:)
-                  un   (:,:,:)   = ub  (:,:,:)
-                  vn   (:,:,:)   = vb  (:,:,:)
-               ELSEIF( ln_wd .or. ln_rwd   ) THEN ! if not test case
-                  sshb(:,:) = 0.0_wp ! slwa
-                  sshn(:,:) = 0.0_wp ! slwa
-
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        IF( ht_wd(ji,jj) <=  rn_wdmin1 ) THEN ! if total depth is less than min depth
-
-                           sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)       
-                           sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                           ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                        ENDIF
-                     ENDDO
-                  ENDDO
-               ENDIF !If wad elseif ln_wd or ln_rwd
-
-               ! Adjust vertical metrics for all wad
-               DO jk = 1, jpk
-                    e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) - rn_ht_0 + sshn(:,:)  ) &
-                      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-                      &            + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
-               END DO
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-
-! MJB - not sure that this is the best location for this check  
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT(ssmask(ji,jj)) .EQ. 1) THEN
-                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
-                     ENDIF
-                  END DO 
-               END DO 
- 
-               !
-            ELSE  ! if not wad case
-               !
-               e3t_b(:,:,:) = e3t_0(:,:,:)
-               e3t_n(:,:,:) = e3t_0(:,:,:)
-               sshn(:,:) = 0.0_wp
-               !
-            END IF
-
-            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN
-               tilde_e3t_b(:,:,:) = 0._wp
-               tilde_e3t_n(:,:,:) = 0._wp
-               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp
-            END IF
-         ENDIF
-         !
-      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
-         !                                   ! ===================
-         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----'
-         !                                           ! --------- !
-         !                                           ! all cases !
-         !                                           ! --------- !
-         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) )
-         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )
-         !                                           ! ----------------------- !
-         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases !
-            !                                        ! ----------------------- !
-            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )
-         END IF
-         !                                           ! -------------!    
-         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case !
-            !                                        ! ------------ !
-            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) )
-         ENDIF
-         !
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst')
-      !
-   END SUBROUTINE dom_vvl_rst
-
-
-   SUBROUTINE dom_vvl_ctl
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_vvl_ctl  ***
-      !!                
-      !! ** Purpose :   Control the consistency between namelist options
-      !!                for vertical coordinate
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ios
-      !!
-      NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
-         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
-         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
-      !!---------------------------------------------------------------------- 
-      !
-      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
-      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nam_vvl )
-      !
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '           Namelist nam_vvl : chose a vertical coordinate'
-         WRITE(numout,*) '              zstar                      ln_vvl_zstar   = ', ln_vvl_zstar
-         WRITE(numout,*) '              ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde
-         WRITE(numout,*) '              layer                      ln_vvl_layer   = ', ln_vvl_layer
-         WRITE(numout,*) '              ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar
-         WRITE(numout,*) '      ztilde near the equator    ln_vvl_zstar_at_eqtor  = ', ln_vvl_zstar_at_eqtor
-         ! WRITE(numout,*) '           Namelist nam_vvl : chose kinetic-to-potential energy conservation'
-         ! WRITE(numout,*) '                                         ln_vvl_kepe    = ', ln_vvl_kepe
-         WRITE(numout,*) '           Namelist nam_vvl : thickness diffusion coefficient'
-         WRITE(numout,*) '                                         rn_ahe3        = ', rn_ahe3
-         WRITE(numout,*) '           Namelist nam_vvl : maximum e3t deformation fractional change'
-         WRITE(numout,*) '                                         rn_zdef_max    = ', rn_zdef_max
-         IF( ln_vvl_ztilde_as_zstar ) THEN
-            WRITE(numout,*) '           ztilde running in zstar emulation mode; '
-            WRITE(numout,*) '           ignoring namelist timescale parameters and using:'
-            WRITE(numout,*) '                 hard-wired : z-tilde to zstar restoration timescale (days)'
-            WRITE(numout,*) '                                         rn_rst_e3t     =    0.0'
-            WRITE(numout,*) '                 hard-wired : z-tilde cutoff frequency of low-pass filter (days)'
-            WRITE(numout,*) '                                         rn_lf_cutoff   =    1.0/rdt'
-         ELSE
-            WRITE(numout,*) '           Namelist nam_vvl : z-tilde to zstar restoration timescale (days)'
-            WRITE(numout,*) '                                         rn_rst_e3t     = ', rn_rst_e3t
-            WRITE(numout,*) '           Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)'
-            WRITE(numout,*) '                                         rn_lf_cutoff   = ', rn_lf_cutoff
-         ENDIF
-         WRITE(numout,*) '           Namelist nam_vvl : debug prints'
-         WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
-      ENDIF
-      !
-      ioptio = 0                      ! Parameter control
-      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
-      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
-      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
-      IF( ln_vvl_layer           )   ioptio = ioptio + 1
-      !
-      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
-      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
-      !
-      IF(lwp) THEN                   ! Print the choice
-         WRITE(numout,*)
-         IF( ln_vvl_zstar           ) WRITE(numout,*) '              zstar vertical coordinate is used'
-         IF( ln_vvl_ztilde          ) WRITE(numout,*) '              ztilde vertical coordinate is used'
-         IF( ln_vvl_layer           ) WRITE(numout,*) '              layer vertical coordinate is used'
-         IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '              to emulate a zstar coordinate'
-         ! - ML - Option not developed yet
-         ! IF(       ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option used'
-         ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
-      ENDIF
-      !
-#if defined key_agrif
-      IF(.NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented with non-linear free surface' )
-#endif
-      !
-   END SUBROUTINE dom_vvl_ctl
-
-   !!======================================================================
-END MODULE domvvl
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domwri.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domwri.F90	(revision 8864)
+++ 	(revision )
@@ -1,326 +1,0 @@
-MODULE domwri
-   !!======================================================================
-   !!                       ***  MODULE domwri  ***
-   !! Ocean initialization : write the ocean domain mesh file(s)
-   !!======================================================================
-   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
-   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
-   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
-   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_wri        : create and write mesh and mask file(s)
-   !!   dom_uniq       : identify unique point of a grid (TUVF)
-   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst ,   ONLY :   rsmall
-   USE wet_dry,   ONLY :   ln_wd, ln_rwd, ht_wd
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE lbclnk          ! lateral boundary conditions - mpp exchanges
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_wri              ! routine called by inidom.F90
-   PUBLIC   dom_stiff            ! routine called by inidom.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
-   !! $Id: domwri.F90 7646 2017-02-06 09:25:03Z timgraham $ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_wri
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_wri  ***
-      !!                   
-      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
-      !!      ocean domain informations (mesh and mask arrays). This (these)
-      !!      file(s) is (are) used for visualisation (SAXO software) and
-      !!      diagnostic computation.
-      !!
-      !! ** Method  :   Write in a file all the arrays generated in routines
-      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
-      !!      the vertical coord. used (z-coord, partial steps, s-coord)
-      !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file
-      !!                         = 2  :   'mesh.nc' and mask.nc' files
-      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
-      !!                                  'mask.nc' files
-      !!      For huge size domain, use option 2 or 3 depending on your 
-      !!      vertical coordinate.
-      !!
-      !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
-      !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
-      !!                        corresponding to the depth of the bottom t- and w-points
-      !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the
-      !!                        thickness (e3[tw]_ps) of the bottom points 
-      !!
-      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
-      !!                                   masks, depth and vertical scale factors
-      !!----------------------------------------------------------------------
-      INTEGER           ::   inum    ! temprary units for 'mesh_mask.nc' file
-      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations)
-      INTEGER           ::   ji, jj, jk   ! dummy loop indices
-      INTEGER           ::   izco, izps, isco, icav
-      !                               
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
-      !
-      CALL wrk_alloc( jpi,jpj,       zprt , zprw  )
-      CALL wrk_alloc( jpi,jpj,jpk,   zdepu, zdepv )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
-      IF(lwp) WRITE(numout,*) '~~~~~~~'
-      
-      clnam = 'mesh_mask'  ! filename (mesh and mask informations)
-      
-      !                                  ! ============================
-      !                                  !  create 'mesh_mask.nc' file
-      !                                  ! ============================
-      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
-      !
-      !                                                         ! 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( jpkglo, wp), ktype = jp_i4 )
-
-      !                                                         ! domain characteristics
-      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 )
-  
-      !                                                         ! masks
-      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
-      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 )
-      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 )
-      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 )
-      
-      CALL dom_uniq( zprw, 'T' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO                             !    ! unique point mask
-      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )  
-      CALL dom_uniq( zprw, 'U' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
-      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )  
-      CALL dom_uniq( zprw, 'V' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
-      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )  
-!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil
-!!    Here we just remove the output of fmaskutil.
-!      CALL dom_uniq( zprw, 'F' )
-!      DO jj = 1, jpj
-!         DO ji = 1, jpi
-!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-!         END DO
-!      END DO
-!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )  
-!!gm
-
-      !                                                         ! horizontal mesh (inum3)
-      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 )         !    ! e1 scale factors
-      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 )         !    ! e2 scale factors
-      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 )
-      
-      ! note that mbkt is set to 1 over land ==> use surface tmask
-      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )   !    ! nb of ocean T-points
-      !															             ! vertical mesh
-      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! 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, 'e3w_0', e3w_0, ktype = jp_r8  )
-      !
-      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system
-      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 )
-      !
-      IF( ln_sco ) THEN                                         ! s-coordinate stiffness
-         CALL dom_stiff( zprt )
-         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )       ! Max. grid stiffness ratio
-      ENDIF
-      !
-      IF( ln_wd .OR. ln_rwd ) CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
-      IF( ln_wd .OR. ln_rwd ) CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
-
-      !                                     ! ============================
-      CALL iom_close( inum )                !        close the files 
-      !                                     ! ============================
-      !
-      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
-      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
-      !
-   END SUBROUTINE dom_wri
-
-
-   SUBROUTINE dom_uniq( puniq, cdgrd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_uniq  ***
-      !!                   
-      !! ** Purpose :   identify unique point of a grid (TUVF)
-      !!
-      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
-      !!                2) check which elements have been changed
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
-      !
-      REAL(wp) ::  zshift   ! shift value link to the process number
-      INTEGER  ::  ji       ! dummy loop indices
-      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
-      !
-      CALL wrk_alloc( jpi, jpj, ztstref )
-      !
-      ! build an array with different values for each element 
-      ! in mpp: make sure that these values are different even between process
-      ! -> apply a shift value according to the process number
-      zshift = jpi * jpj * ( narea - 1 )
-      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
-      !
-      puniq(:,:) = ztstref(:,:)                   ! default definition
-      CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions
-      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
-      !
-      puniq(:,:) = 1.                             ! default definition
-      ! fill only the inner part of the cpu with llbl converted into real 
-      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
-      !
-      CALL wrk_dealloc( jpi, jpj, ztstref )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
-      !
-   END SUBROUTINE dom_uniq
-
-
-   SUBROUTINE dom_stiff( px1 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_stiff  ***
-      !!                     
-      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
-      !!
-      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
-      !!                Save the maximum in the vertical direction
-      !!                (this number is only relevant in s-coordinates)
-      !!
-      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
-      !
-      INTEGER  ::   ji, jj, jk 
-      REAL(wp) ::   zrxmax
-      REAL(wp), DIMENSION(4) ::   zr1
-      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
-      !!----------------------------------------------------------------------
-      zx1(:,:) = 0._wp
-      zrxmax   = 0._wp
-      zr1(:)   = 0._wp
-      !
-      DO ji = 2, jpim1
-         DO jj = 2, jpjm1
-            DO jk = 1, jpkm1
-!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
-!!             especially since it is gde3w which is used to compute the pressure gradient
-!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
-!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
-               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
-                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
-                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
-                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
-               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
-                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
-                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
-                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
-               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
-                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
-                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
-                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
-               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
-                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
-                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
-                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
-               zrxmax = MAXVAL( zr1(1:4) )
-               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( zx1, 'T', 1. )
-      !
-      IF( PRESENT( px1 ) )    px1 = zx1
-      !
-      zrxmax = MAXVAL( zx1 )
-      !
-      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
-         WRITE(numout,*) '~~~~~~~~~'
-      ENDIF
-      !
-   END SUBROUTINE dom_stiff
-
-   !!======================================================================
-END MODULE domwri
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domzgr.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domzgr.F90	(revision 8864)
+++ 	(revision )
@@ -1,328 +1,0 @@
-MODULE domzgr
-   !!==============================================================================
-   !!                       ***  MODULE domzgr   ***
-   !! Ocean domain : definition of the vertical coordinate system
-   !!==============================================================================
-   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
-   !!                 ! 1997-07  (G. Madec)  lbc_lnk call
-   !!                 ! 1997-04  (J.-O. Beismann) 
-   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
-   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
-   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
-   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
-   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
-   !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
-   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
-   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
-   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
-   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye  
-   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_zgr       : read or set the ocean vertical coordinate system
-   !!   zgr_read      : read the vertical information in the domain configuration file
-   !!   zgr_top_bot   : ocean top and bottom level for t-, u, and v-points with 1 as minimum value
-   !!---------------------------------------------------------------------
-   USE oce            ! ocean variables
-   USE dom_oce        ! ocean domain
-   USE usrdef_zgr     ! user defined vertical coordinate system
-   USE depth_e3       ! depth <=> e3
-   USE wet_dry, ONLY: ln_wd, ln_rwd, ht_wd
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! distributed memory computing library
-   USE wrk_nemo       ! Memory allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_zgr        ! called by dom_init.F90
-
-  !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
-   !! $Id: domzgr.F90 7753 2017-03-03 11:46:59Z mocavero $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS       
-
-   SUBROUTINE dom_zgr( k_top, k_bot )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_zgr  ***
-      !!                   
-      !! ** Purpose :   set the depth of model levels and the resulting 
-      !!              vertical scale factors.
-      !!
-      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
-      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
-      !!              - vertical coordinate (gdep., e3.) depending on the 
-      !!                coordinate chosen :
-      !!                   ln_zco=T   z-coordinate   
-      !!                   ln_zps=T   z-coordinate with partial steps
-      !!                   ln_zco=T   s-coordinate 
-      !!
-      !! ** Action  :   define gdep., e3., mbathy and bathy
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices
-      !
-      INTEGER  ::   jk                  ! dummy loop index
-      INTEGER  ::   ioptio, ibat, ios   ! local integer
-      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m)
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_zgr')
-      !
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_zgr : vertical coordinate'
-         WRITE(numout,*) '~~~~~~~'
-      ENDIF
-
-      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
-
-
-      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          Read vertical mesh in ', TRIM( cn_domcfg ), ' file'
-         !
-         CALL zgr_read   ( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
-            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
-            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth 
-            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
-            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
-            &              k_top   , k_bot            )                  ! 1st & last ocean level
-         !
-      ELSE                          !==  User defined configuration  ==!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          User defined vertical mesh (usr_def_zgr)'
-         !
-         CALL usr_def_zgr( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
-            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
-            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth 
-            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
-            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
-            &              k_top   , k_bot            )                  ! 1st & last ocean level
-         !
-      ENDIF
-      !
-!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears
-      ! Compute gde3w_0 (vertical sum of e3w)
-      gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
-      DO jk = 2, jpk
-         gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
-      END DO
-      !
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :'
-         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
-         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
-         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
-         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
-      ENDIF
-
-      ioptio = 0                       ! Check Vertical coordinate options
-      IF( ln_zco      )   ioptio = ioptio + 1
-      IF( ln_zps      )   ioptio = ioptio + 1
-      IF( ln_sco      )   ioptio = ioptio + 1
-      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
-
-
-      !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top)
-      CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1
-      
-
-      !                                ! deepest/shallowest W level Above/Below ~10m
-!!gm BUG in s-coordinate this does not work!
-      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
-      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
-      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
-!!gm end bug
-      !
-      IF( nprint == 1 .AND. lwp )   THEN
-         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) )
-         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) )
-         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
-            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )
-         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
-            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
-            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
-            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
-
-         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
-            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )
-         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
-            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
-            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
-            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_zgr')
-      !
-   END SUBROUTINE dom_zgr
-
-
-   SUBROUTINE zgr_read( 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 zgr_read  ***
-      !!
-      !! ** Purpose :   Read the vertical information in the domain configuration file
-      !!
-      !!----------------------------------------------------------------------
-      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 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 , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level
-      !
-      INTEGER  ::   jk     ! dummy loop index
-      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) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   zgr_read : read the vertical coordinates in ', TRIM( cn_domcfg ), ' file'
-         WRITE(numout,*) '   ~~~~~~~~'
-      ENDIF
-      !
-      CALL iom_open( cn_domcfg, inum )
-      !
-      !                          !* type of vertical coordinate
-      CALL iom_get( inum, 'ln_zco'   , z_zco )
-      CALL iom_get( inum, 'ln_zps'   , z_zps )
-      CALL iom_get( inum, 'ln_sco'   , z_sco )
-      IF( z_zco == 0._wp ) THEN   ;   ld_zco = .false.   ;   ELSE   ;   ld_zco = .true.   ;   ENDIF
-      IF( z_zps == 0._wp ) THEN   ;   ld_zps = .false.   ;   ELSE   ;   ld_zps = .true.   ;   ENDIF
-      IF( z_sco == 0._wp ) THEN   ;   ld_sco = .false.   ;   ELSE   ;   ld_sco = .true.   ;   ENDIF
-      !
-      !                          !* ocean cavities under iceshelves
-      CALL iom_get( inum, 'ln_isfcav', z_cav )
-      IF( z_cav == 0._wp ) THEN   ;   ld_isfcav = .false.   ;   ELSE   ;   ld_isfcav = .true.   ;   ENDIF
-      !
-      !                          !* vertical scale factors
-      CALL iom_get( inum, jpdom_unknown, 'e3t_1d'  , pe3t_1d  )                     ! 1D reference coordinate
-      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  )
-      !
-      CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate
-      CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr )
-      !
-      !                          !* depths
-      !                                   !- old depth definition (obsolescent feature)
-      IF(  iom_varid( inum, 'gdept_1d', ldstop = .FALSE. ) > 0  .AND.  &
-         & iom_varid( inum, 'gdepw_1d', ldstop = .FALSE. ) > 0  .AND.  &
-         & iom_varid( inum, 'gdept_0' , ldstop = .FALSE. ) > 0  .AND.  &
-         & iom_varid( inum, 'gdepw_0' , ldstop = .FALSE. ) > 0    ) THEN
-         CALL ctl_warn( 'zgr_read : old definition of depths and scale factors used ', & 
-            &           '           depths at t- and w-points read in the domain configuration file')
-         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )   
-         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d )
-         CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr )
-         CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr )
-         !
-      ELSE                                !- depths computed from e3. scale factors
-         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth
-         CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths
-         IF(lwp) THEN
-            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
-      ENDIF
-      !
-      !                          !* ocean top and bottom level
-      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF)
-      k_top(:,:) = INT( z2d(:,:) )
-      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points
-      k_bot(:,:) = INT( z2d(:,:) )
-      !
-      ! bathymetry with orography (wetting and drying only)
-      IF( ln_wd .OR. ln_rwd )  CALL iom_get( inum, jpdom_data, 'ht_wd' , ht_wd  , lrowattr=ln_use_jattr )
-      !
-      CALL iom_close( inum )
-      !
-   END SUBROUTINE zgr_read
-
-
-   SUBROUTINE zgr_top_bot( k_top, k_bot )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE zgr_top_bot  ***
-      !!
-      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
-      !!
-      !! ** Method  :   computes from k_top and k_bot with a minimum value of 1 over land
-      !!
-      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
-      !!                                     ocean level at t-, u- & v-points
-      !!                                     (min value = 1)
-      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
-      !!                                     ocean level at t-, u- & v-points
-      !!                                     (min value = 1 over land)
-      !!----------------------------------------------------------------------
-      INTEGER , DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! top & bottom ocean level indices
-      !
-      INTEGER ::   ji, jj   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zk
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zgr_top_bot')
-      !
-      CALL wrk_alloc( jpi,jpj,   zk )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '    zgr_top_bot : ocean top and bottom k-index of T-, U-, V- and W-levels '
-      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
-      !
-      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land)
-      !
-      mbkt(:,:) = MAX( k_bot(:,:) , 1 )    ! bottom ocean k-index of T-level (=1 over land)
- 
-      !                                    ! N.B.  top     k-index of W-level = mikt
-      !                                    !       bottom  k-index of W-level = mbkt+1
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
-            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
-            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
-            !
-            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
-            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
-         END DO
-      END DO
-      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
-      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( INT( zk(:,:) ), 1 )
-      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( INT( zk(:,:) ), 1 )
-      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( INT( zk(:,:) ), 1 )
-      !
-      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( INT( zk(:,:) ), 1 )
-      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 )
-      !
-      CALL wrk_dealloc( jpi,jpj,   zk )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zgr_top_bot')
-      !
-   END SUBROUTINE zgr_top_bot
-
-   !!======================================================================
-END MODULE domzgr
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/dynhpg.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/dynhpg.F90	(revision 8864)
+++ 	(revision )
@@ -1,1503 +1,0 @@
-MODULE dynhpg
-   !!======================================================================
-   !!                       ***  MODULE  dynhpg  ***
-   !! Ocean dynamics:  hydrostatic pressure gradient trend
-   !!======================================================================
-   !! History :  OPA  !  1987-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code
-   !!            5.0  !  1991-11  (G. Madec)
-   !!            7.0  !  1996-01  (G. Madec)  hpg_sco: Original code for s-coordinates
-   !!            8.0  !  1997-05  (G. Madec)  split dynber into dynkeg and dynhpg
-   !!            8.5  !  2002-07  (G. Madec)  F90: Free form and module
-   !!            8.5  !  2002-08  (A. Bozec)  hpg_zps: Original code
-   !!   NEMO     1.0  !  2005-10  (A. Beckmann, B.W. An)  various s-coordinate options
-   !!                 !         Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot
-   !!             -   !  2005-11  (G. Madec) style & small optimisation
-   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
-   !!            3.4  !  2011-11  (H. Liu) hpg_prj: Original code for s-coordinates
-   !!                 !           (A. Coward) suppression of hel, wdj and rot options
-   !!            3.6  !  2014-11  (P. Mathiot) hpg_isf: original code for ice shelf cavity
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_hpg      : update the momentum trend with the now horizontal
-   !!                  gradient of the hydrostatic pressure
-   !!   dyn_hpg_init : initialisation and control of options
-   !!       hpg_zco  : z-coordinate scheme
-   !!       hpg_zps  : z-coordinate plus partial steps (interpolation)
-   !!       hpg_sco  : s-coordinate (standard jacobian formulation)
-   !!       hpg_isf  : s-coordinate (sco formulation) adapted to ice shelf
-   !!       hpg_djc  : s-coordinate (Density Jacobian with Cubic polynomial)
-   !!       hpg_prj  : s-coordinate (Pressure Jacobian with Cubic polynomial)
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE sbc_oce         ! surface variable (only for the flag with ice shelf)
-   USE dom_oce         ! ocean space and time domain
-   USE wet_dry         ! wetting and drying
-   USE phycst          ! physical constants
-   USE trd_oce         ! trends: ocean variables
-   USE trddyn          ! trend manager: dynamics
-!jc   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
-   !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lbclnk          ! lateral boundary condition 
-   USE lib_mpp         ! MPP library
-   USE eosbn2          ! compute density
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE iom
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_hpg        ! routine called by step module
-   PUBLIC   dyn_hpg_init   ! routine called by opa module
-
-   !                                 !!* Namelist namdyn_hpg : hydrostatic pressure gradient
-   LOGICAL , PUBLIC ::   ln_hpg_zco   !: z-coordinate - full steps
-   LOGICAL , PUBLIC ::   ln_hpg_zps   !: z-coordinate - partial steps (interpolation)
-   LOGICAL , PUBLIC ::   ln_hpg_sco   !: s-coordinate (standard jacobian formulation)
-   LOGICAL , PUBLIC ::   ln_hpg_djc   !: s-coordinate (Density Jacobian with Cubic polynomial)
-   LOGICAL , PUBLIC ::   ln_hpg_prj   !: s-coordinate (Pressure Jacobian scheme)
-   LOGICAL , PUBLIC ::   ln_hpg_isf   !: s-coordinate similar to sco modify for isf
-
-   INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM)
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: dynhpg.F90 7761 2017-03-06 17:58:35Z clem $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_hpg( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_hpg  ***
-      !!
-      !! ** Method  :   Call the hydrostatic pressure gradient routine
-      !!              using the scheme defined in the namelist
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T)
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_hpg')
-      !
-      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn)
-         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
-      ENDIF
-      !
-      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation
-      CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate
-      CASE (  1 )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation)
-      CASE (  2 )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation)
-      CASE (  3 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial)
-      CASE (  4 )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme)
-      CASE (  5 )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf
-      END SELECT
-      !
-      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt )
-         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_hpg')
-      !
-   END SUBROUTINE dyn_hpg
-
-
-   SUBROUTINE dyn_hpg_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dyn_hpg_init  ***
-      !!
-      !! ** Purpose :   initializations for the hydrostatic pressure gradient
-      !!              computation and consistency control
-      !!
-      !! ** Action  :   Read the namelist namdyn_hpg and check the consistency
-      !!      with the type of vertical coordinate used (zco, zps, sco)
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio = 0      ! temporary integer
-      INTEGER ::   ios             ! Local integer output status for namelist read
-      !!
-      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF
-      REAL(wp) ::   znad
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density
-      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF
-      REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF
-      !!
-      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     &
-         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient
-      READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient
-      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namdyn_hpg )
-      !
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_hpg_init : hydrostatic pressure gradient initialisation'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namdyn_hpg : choice of hpg scheme'
-         WRITE(numout,*) '      z-coord. - full steps                             ln_hpg_zco    = ', ln_hpg_zco
-         WRITE(numout,*) '      z-coord. - partial steps (interpolation)          ln_hpg_zps    = ', ln_hpg_zps
-         WRITE(numout,*) '      s-coord. (standard jacobian formulation)          ln_hpg_sco    = ', ln_hpg_sco
-         WRITE(numout,*) '      s-coord. (standard jacobian formulation) for isf  ln_hpg_isf    = ', ln_hpg_isf
-         WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc
-         WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj
-      ENDIF
-      !
-      IF( ln_hpg_djc )   &
-         &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method &
-                           & currently disabled (bugs under investigation). Please select &
-                           & either  ln_hpg_sco or  ln_hpg_prj instead')
-      !
-      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        &
-         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', &
-         &                 '   the standard jacobian formulation hpg_sco    or '    , &
-         &                 '   the pressure jacobian formulation hpg_prj'            )
-
-      IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   &
-         &   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' )
-      IF( .NOT. ln_hpg_isf .AND.       ln_isfcav )   &
-         &   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' )
-      !
-      !                               ! Set nhpg from ln_hpg_... flags
-      IF( ln_hpg_zco )   nhpg = 0
-      IF( ln_hpg_zps )   nhpg = 1
-      IF( ln_hpg_sco )   nhpg = 2
-      IF( ln_hpg_djc )   nhpg = 3
-      IF( ln_hpg_prj )   nhpg = 4
-      IF( ln_hpg_isf )   nhpg = 5
-      !
-      !                               ! Consistency check
-      ioptio = 0
-      IF( ln_hpg_zco )   ioptio = ioptio + 1
-      IF( ln_hpg_zps )   ioptio = ioptio + 1
-      IF( ln_hpg_sco )   ioptio = ioptio + 1
-      IF( ln_hpg_djc )   ioptio = ioptio + 1
-      IF( ln_hpg_prj )   ioptio = ioptio + 1
-      IF( ln_hpg_isf )   ioptio = ioptio + 1
-      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
-      ! 
-      ! initialisation of ice shelf load
-      IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0
-      IF (       ln_isfcav ) THEN
-         CALL wrk_alloc( jpi,jpj, 2,  ztstop) 
-         CALL wrk_alloc( jpi,jpj,jpk, zrhd  )
-         CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload) 
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'  
-
-         ! To use density and not density anomaly
-         znad=1._wp
-         
-         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
-         ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp
-
-         ! compute density of the water displaced by the ice shelf 
-         DO jk = 1, jpk
-            CALL eos(ztstop(:,:,:),gdept_n(:,:,jk),zrhd(:,:,jk))
-         END DO
-      
-         ! compute rhd at the ice/oce interface (ice shelf side)
-         CALL eos(ztstop,risfdep,zrhdtop_isf)
-
-         ! Surface value + ice shelf gradient
-         ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v)
-         ! divided by 2 later
-         ziceload = 0._wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt=mikt(ji,jj)
-               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1))
-               DO jk=2,ikt-1
-                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) &
-                     &                              * (1._wp - tmask(ji,jj,jk))
-               END DO
-               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
-                                  &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) )
-            END DO
-         END DO
-         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5
-
-         CALL wrk_dealloc( jpi,jpj, 2,  ztstop) 
-         CALL wrk_dealloc( jpi,jpj,jpk, zrhd  )
-         CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload) 
-      END IF
-      !
-   END SUBROUTINE dyn_hpg_init
-
-
-   SUBROUTINE hpg_zco( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_zco  ***
-      !!
-      !! ** Method  :   z-coordinate case, levels are horizontal surfaces.
-      !!      The now hydrostatic pressure gradient at a given level, jk,
-      !!      is computed by taking the vertical integral of the in-situ
-      !!      density gradient along the model level from the suface to that
-      !!      level:    zhpi = grav .....
-      !!                zhpj = grav .....
-      !!      add it to the general momentum trend (ua,va).
-      !!            ua = ua - 1/e1u * zhpi
-      !!            va = va - 1/e2v * zhpj
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk       ! dummy loop indices
-      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case '
-      ENDIF
-
-      zcoef0 = - grav * 0.5_wp      ! Local constant initialization
-
-      ! Surface value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
-
-      !
-      ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! hydrostatic pressure gradient
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    &
-                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
-
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    &
-                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
-      !
-   END SUBROUTINE hpg_zco
-
-
-   SUBROUTINE hpg_zps( kt )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE hpg_zps  ***
-      !!
-      !! ** Method  :   z-coordinate plus partial steps case.  blahblah...
-      !!
-      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
-      INTEGER  ::   iku, ikv                         ! temporary integers
-      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization'
-      ENDIF
-
-      ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level
-!jc      CALL zps_hde    ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv )
-
-      ! Local constant initialization
-      zcoef0 = - grav * 0.5_wp
-
-      !  Surface value (also valid in partial step case)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
-
-      ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! hydrostatic pressure gradient
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
-                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
-
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
-                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90)
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) )
-            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) )
-            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
-               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
-                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
-            ENDIF
-            IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value
-               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
-                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
-            ENDIF
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
-      !
-   END SUBROUTINE hpg_zps
-
-
-   SUBROUTINE hpg_sco( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_sco  ***
-      !!
-      !! ** Method  :   s-coordinate case. Jacobian scheme.
-      !!      The now hydrostatic pressure gradient at a given level, jk,
-      !!      is computed by taking the vertical integral of the in-situ
-      !!      density gradient along the model level from the suface to that
-      !!      level. s-coordinates (ln_sco): a corrective term is added
-      !!      to the horizontal pressure gradient :
-      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
-      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
-      !!      add it to the general momentum trend (ua,va).
-      !!         ua = ua - 1/e1u * zhpi
-      !!         va = va - 1/e2v * zhpj
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices
-      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars
-      LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
-      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
-      ENDIF
-      !
-      zcoef0 = - grav * 0.5_wp
-      IF ( ln_linssh ) THEN   ;   znad = 0._wp         ! Fixed    volume: density anomaly
-      ELSE                    ;   znad = 1._wp         ! Variable volume: density
-      ENDIF
-      !
-      IF( ln_wd ) THEN
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
-        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
-      END IF
-
-      ! Surface value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ! hydrostatic pressure gradient along s-surfaces
-            zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
-            ! s-coordinate pressure gradient correction
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-
-
-            IF( ln_wd ) THEN
-
-              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-              zuap = zuap * zcpx(ji,jj)
-              zvap = zvap * zcpy(ji,jj)
-            ENDIF
-
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
-         END DO
-      END DO
-
-      ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj)
-
-               IF( ln_wd ) THEN
-                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-                 zuap = zuap * zcpx(ji,jj)
-                 zvap = zvap * zcpy(ji,jj)
-               ENDIF
-
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
-      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
-      !
-   END SUBROUTINE hpg_sco
-
-
-   SUBROUTINE hpg_isf( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_isf  ***
-      !!
-      !! ** Method  :   s-coordinate case. Jacobian scheme.
-      !!      The now hydrostatic pressure gradient at a given level, jk,
-      !!      is computed by taking the vertical integral of the in-situ
-      !!      density gradient along the model level from the suface to that
-      !!      level. s-coordinates (ln_sco): a corrective term is added
-      !!      to the horizontal pressure gradient :
-      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
-      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
-      !!      add it to the general momentum trend (ua,va).
-      !!         ua = ua - 1/e1u * zhpi
-      !!         va = va - 1/e2v * zhpj
-      !!      iceload is added and partial cell case are added to the top and bottom
-      !!      
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices
-      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop
-      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,  2, ztstop) 
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj)
-      CALL wrk_alloc( jpi,jpj,     zrhdtop_oce )
-      !
-      ! Local constant initialization
-      zcoef0 = - grav * 0.5_wp
-  
-      ! To use density and not density anomaly
-      znad=1._wp
-
-      ! iniitialised to 0. zhpi zhpi 
-      zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp
-
-      ! compute rhd at the ice/oce interface (ocean side)
-      ! usefull to reduce residual current in the test case ISOMIP with no melting
-      DO ji=1,jpi
-        DO jj=1,jpj
-          ikt=mikt(ji,jj)
-          ztstop(ji,jj,1)=tsn(ji,jj,ikt,1)
-          ztstop(ji,jj,2)=tsn(ji,jj,ikt,2)
-        END DO
-      END DO
-      CALL eos( ztstop, risfdep, zrhdtop_oce )
-
-!==================================================================================     
-!===== Compute surface value ===================================================== 
-!==================================================================================
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ikt    = mikt(ji,jj)
-            iktp1i = mikt(ji+1,jj)
-            iktp1j = mikt(ji,jj+1)
-            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
-            ! we assume ISF is in isostatic equilibrium
-            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            ) 
-            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            ) 
-            ! s-coordinate pressure gradient correction (=0 if z coordinate)
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
-         END DO
-      END DO
-!==================================================================================     
-!===== Compute interior value ===================================================== 
-!==================================================================================
-      ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-     !
-      CALL wrk_dealloc( jpi,jpj,2  , ztstop)
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj)
-      CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce )
-      !
-   END SUBROUTINE hpg_isf
-
-
-   SUBROUTINE hpg_djc( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_djc  ***
-      !!
-      !! ** Method  :   Density Jacobian with Cubic polynomial scheme
-      !!
-      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk          ! dummy loop indices
-      REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars
-      REAL(wp) ::   z1_10, cffu, cffx   !    "         "
-      REAL(wp) ::   z1_12, cffv, cffy   !    "         "
-      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  rho_i, rho_j, rho_k
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )
-      CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
-      CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
-      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
-      !
-      !
-      IF( ln_wd ) THEN
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
-        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
-      END IF
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme'
-      ENDIF
-
-      ! Local constant initialization
-      zcoef0 = - grav * 0.5_wp
-      z1_10  = 1._wp / 10._wp
-      z1_12  = 1._wp / 12._wp
-
-      !----------------------------------------------------------------------------------------
-      !  compute and store in provisional arrays elementary vertical and horizontal differences
-      !----------------------------------------------------------------------------------------
-
-!!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really
-
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
-               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1)
-               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
-               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  )
-               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
-               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  )
-            END DO
-         END DO
-      END DO
-
-      !-------------------------------------------------------------------------
-      ! compute harmonic averages using eq. 5.18
-      !-------------------------------------------------------------------------
-      zep = 1.e-15
-
-!!bug  gm  drhoz not defined at level 1 and used (jk-1 with jk=2)
-!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj
-
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
-
-               cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
-               cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
-
-               cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
-               cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
-
-               IF( cffw > zep) THEN
-                  drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
-                     &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
-               ELSE
-                  drhow(ji,jj,jk) = 0._wp
-               ENDIF
-
-               dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
-                  &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
-
-               IF( cffu > zep ) THEN
-                  drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
-                     &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
-               ELSE
-                  drhou(ji,jj,jk ) = 0._wp
-               ENDIF
-
-               IF( cffx > zep ) THEN
-                  dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
-                     &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
-               ELSE
-                  dzu(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffv > zep ) THEN
-                  drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
-                     &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
-               ELSE
-                  drhov(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffy > zep ) THEN
-                  dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
-                     &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
-               ELSE
-                  dzv(ji,jj,jk) = 0._wp
-               ENDIF
-
-            END DO
-         END DO
-      END DO
-
-      !----------------------------------------------------------------------------------
-      ! apply boundary conditions at top and bottom using 5.36-5.37
-      !----------------------------------------------------------------------------------
-      drhow(:,:, 1 ) = 1.5_wp * ( drhoz(:,:, 2 ) - drhoz(:,:,  1  ) ) - 0.5_wp * drhow(:,:,  2  )
-      drhou(:,:, 1 ) = 1.5_wp * ( drhox(:,:, 2 ) - drhox(:,:,  1  ) ) - 0.5_wp * drhou(:,:,  2  )
-      drhov(:,:, 1 ) = 1.5_wp * ( drhoy(:,:, 2 ) - drhoy(:,:,  1  ) ) - 0.5_wp * drhov(:,:,  2  )
-
-      drhow(:,:,jpk) = 1.5_wp * ( drhoz(:,:,jpk) - drhoz(:,:,jpkm1) ) - 0.5_wp * drhow(:,:,jpkm1)
-      drhou(:,:,jpk) = 1.5_wp * ( drhox(:,:,jpk) - drhox(:,:,jpkm1) ) - 0.5_wp * drhou(:,:,jpkm1)
-      drhov(:,:,jpk) = 1.5_wp * ( drhoy(:,:,jpk) - drhoy(:,:,jpkm1) ) - 0.5_wp * drhov(:,:,jpkm1)
-
-
-      !--------------------------------------------------------------
-      ! Upper half of top-most grid box, compute and store
-      !-------------------------------------------------------------
-
-!!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified
-!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               &
-               &                   * (  rhd(ji,jj,1)                                     &
-               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
-               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  &
-               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  )
-         END DO
-      END DO
-
-!!bug gm    : here also, simplification is possible
-!!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop
-
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
-                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   &
-                  &            - grav * z1_10 * (                                                                   &
-                  &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
-                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
-                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
-                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
-                  &                             )
-
-               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
-                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
-                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
-                  &                            )
-
-               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
-                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
-                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
-                  &                            )
-
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk(rho_k,'W',1.)
-      CALL lbc_lnk(rho_i,'U',1.)
-      CALL lbc_lnk(rho_j,'V',1.)
-
-
-      ! ---------------
-      !  Surface value
-      ! ---------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
-            IF( ln_wd ) THEN
-              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-            ENDIF
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
-
-      ! ----------------
-      !  interior value   (2=<jk=<jpkm1)
-      ! ----------------
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
-                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
-                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
-                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
-                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
-               IF( ln_wd ) THEN
-                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-               ENDIF
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )
-      CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
-      CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
-      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
-      !
-   END SUBROUTINE hpg_djc
-
-
-   SUBROUTINE hpg_prj( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_prj  ***
-      !!
-      !! ** Method  :   s-coordinate case.
-      !!      A Pressure-Jacobian horizontal pressure gradient method
-      !!      based on the constrained cubic-spline interpolation for
-      !!      all vertical coordinate systems
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear
-      INTEGER, INTENT(in) ::   kt                   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices
-      REAL(wp) ::   zcoef0, znad                    ! local scalars
-      !
-      !! The local variables for the correction term
-      INTEGER  :: jk1, jis, jid, jjs, jjd
-      LOGICAL  :: ll_tmp1, ll_tmp2                  ! local logical variables
-      REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps
-      REAL(wp) :: zrhdt1
-      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
-      CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh )
-      CALL wrk_alloc( jpi,jpj,       zsshu_n, zsshv_n )
-      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian'
-      ENDIF
-
-      ! Local constant initialization
-      zcoef0 = - grav
-      znad = 1._wp
-      IF( ln_linssh )   znad = 0._wp
-
-      IF( ln_wd ) THEN
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-              
-                zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
-                  &                                                         > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
-                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
-                zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
-
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
-        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
-      END IF
-
-      ! Clean 3-D work arrays
-      zhpi(:,:,:) = 0._wp
-      zrhh(:,:,:) = rhd(:,:,:)
-
-      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate
-      DO jj = 1, jpj
-        DO ji = 1, jpi
-          jk = mbkt(ji,jj)+1
-          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
-          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
-          ELSEIF( jk < jpkm1 ) THEN
-             DO jkk = jk+1, jpk
-                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   &
-                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
-             END DO
-          ENDIF
-        END DO
-      END DO
-
-      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)"
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad
-         END DO
-      END DO
-
-      DO jk = 2, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      fsp(:,:,:) = zrhh (:,:,:)
-      xsp(:,:,:) = zdept(:,:,:)
-
-      ! Construct the vertical density profile with the
-      ! constrained cubic spline interpolation
-      ! rho(z) = asp + bsp*z + csp*z^2 + dsp*z^3
-      CALL cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
-
-      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
-      DO jj = 2, jpj
-        DO ji = 2, jpi
-          zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
-             &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1)
-
-          ! assuming linear profile across the top half surface layer
-          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1
-        END DO
-      END DO
-
-      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)"
-      DO jk = 2, jpkm1
-        DO jj = 2, jpj
-          DO ji = 2, jpi
-            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
-               &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
-               &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
-               &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
-          END DO
-        END DO
-      END DO
-
-      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
-
-      ! Prepare zsshu_n and zsshv_n
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-!!gm BUG ?    if it is ssh at u- & v-point then it should be:
-!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * &
-!                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * &
-!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
-!!gm not this:
-          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
-                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
-                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
-        END DO
-      END DO
-
-      CALL lbc_lnk (zsshu_n, 'U', 1.)
-      CALL lbc_lnk (zsshv_n, 'V', 1.)
-
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 
-          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad)
-        END DO
-      END DO
-
-      DO jk = 2, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-            zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-          END DO
-        END DO
-      END DO
-
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zpwes = 0._wp; zpwed = 0._wp
-            zpnss = 0._wp; zpnsd = 0._wp
-            zuijk = zu(ji,jj,jk)
-            zvijk = zv(ji,jj,jk)
-
-            !!!!!     for u equation
-            IF( jk <= mbku(ji,jj) ) THEN
-               IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jis = ji + 1; jid = ji
-               ELSE
-                 jis = ji;     jid = ji +1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
-                 IF( jk1 == mbku(ji,jj) ) THEN
-                   zuijk = -zdept(jis,jj,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
-                 zpwes = zpwes +                                    &
-                      integ_spline(zdept(jis,jj,jk1), zdeps,            &
-                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
-                             csp(jis,jj,jk1),    dsp(jis,jj,jk1))
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)
-                   zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
-                                                     bsp(jid,jj,1),   csp(jid,jj,1), &
-                                                     dsp(jid,jj,1)) * zdeps
-                   zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
-                 zpwed = zpwed +                                        &
-                        integ_spline(zdeps,              zdept(jid,jj,jk1), &
-                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
-                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-               ! update the momentum trends in u direction
-
-               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
-                    &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
-                ELSE
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
-               ENDIF
-               IF( ln_wd ) THEN
-                  zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
-                  zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
-               ENDIF
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
-            ENDIF
-
-            !!!!!     for v equation
-            IF( jk <= mbkv(ji,jj) ) THEN
-               IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jjs = jj + 1; jjd = jj
-               ELSE
-                 jjs = jj    ; jjd = jj + 1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
-                 IF( jk1 == mbkv(ji,jj) ) THEN
-                   zvijk = -zdept(ji,jjs,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
-                 zpnss = zpnss +                                      &
-                        integ_spline(zdept(ji,jjs,jk1), zdeps,            &
-                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
-                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)
-                   zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
-                                                     bsp(ji,jjd,1),   csp(ji,jjd,1), &
-                                                     dsp(ji,jjd,1) ) * zdeps
-                   zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
-                 zpnsd = zpnsd +                                        &
-                        integ_spline(zdeps,              zdept(ji,jjd,jk1), &
-                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
-                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-
-               ! update the momentum trends in v direction
-
-               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
-                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
-               ELSE
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
-               ENDIF
-               IF( ln_wd ) THEN
-                  zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
-                  zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
-               ENDIF
-
-               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
-            ENDIF
-               !
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
-      CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh )
-      CALL wrk_dealloc( jpi,jpj,       zsshu_n, zsshv_n )
-      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
-      !
-   END SUBROUTINE hpg_prj
-
-
-   SUBROUTINE cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE cspline  ***
-      !!
-      !! ** Purpose :   constrained cubic spline interpolation
-      !!
-      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3
-      !!
-      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function
-      INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear
-      !
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      INTEGER  ::   jpi, jpj, jpkm1
-      REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp
-      REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha
-      REAL(wp) ::   zdf(size(fsp,3))
-      !!----------------------------------------------------------------------
-      !
-!!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!  
-      jpi   = size(fsp,1)
-      jpj   = size(fsp,2)
-      jpkm1 = MAX( 1, size(fsp,3) - 1 )
-      !
-      IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-           !!Fritsch&Butland's method, 1984 (preferred, but more computation)
-           !    DO jk = 2, jpkm1-1
-           !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)
-           !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
-           !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1
-           !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2
-           !
-           !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp
-           !
-           !       IF(zdf1 * zdf2 <= 0._wp) THEN
-           !           zdf(jk) = 0._wp
-           !       ELSE
-           !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 )
-           !       ENDIF
-           !    END DO
-
-           !!Simply geometric average
-               DO jk = 2, jpkm1-1
-                  zdf1 = (fsp(ji,jj,jk) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk) - xsp(ji,jj,jk-1))
-                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk))
-
-                  IF(zdf1 * zdf2 <= 0._wp) THEN
-                     zdf(jk) = 0._wp
-                  ELSE
-                     zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2)
-                  ENDIF
-               END DO
-
-               zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / &
-                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2)
-               zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / &
-                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1)
-
-               DO jk = 1, jpkm1 - 1
-                 zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
-                 ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp
-                 ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp
-                 zddf1  = -2._wp * ztmp1 + ztmp2
-                 ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp
-                 zddf2  =  2._wp * ztmp1 - ztmp2
-
-                 dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp
-                 csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp
-                 bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &
-                               & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - &
-                               & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - &
-                               &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk))
-                 asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + &
-                               &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + &
-                               &                 dsp(ji,jj,jk) * xsp(ji,jj,jk))))
-               END DO
-            END DO
-         END DO
-
-      ELSEIF ( polynomial_type == 2 ) THEN     ! Linear
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-               DO jk = 1, jpkm1-1
-                  zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
-                  ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk)
-
-                  dsp(ji,jj,jk) = 0._wp
-                  csp(ji,jj,jk) = 0._wp
-                  bsp(ji,jj,jk) = ztmp1 / zdxtmp
-                  asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-      ELSE
-           CALL ctl_stop( 'invalid polynomial type in cspline' )
-      ENDIF
-
-   END SUBROUTINE cspline
-
-
-   FUNCTION interp1(x, xl, xr, fl, fr)  RESULT(f)
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE interp1  ***
-      !!
-      !! ** Purpose :   1-d linear interpolation
-      !!
-      !! ** Method  :   interpolation is straight forward
-      !!                extrapolation is also permitted (no value limit)
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr
-      REAL(wp)             ::  f ! result of the interpolation (extrapolation)
-      REAL(wp)             ::  zdeltx
-      !!----------------------------------------------------------------------
-      !
-      zdeltx = xr - xl
-      IF( abs(zdeltx) <= 10._wp * EPSILON(x) ) THEN
-         f = 0.5_wp * (fl + fr)
-      ELSE
-         f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx
-      ENDIF
-      !
-   END FUNCTION interp1
-
-
-   FUNCTION interp2( x, a, b, c, d )  RESULT(f)
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE interp1  ***
-      !!
-      !! ** Purpose :   1-d constrained cubic spline interpolation
-      !!
-      !! ** Method  :  cubic spline interpolation
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::  x, a, b, c, d
-      REAL(wp)             ::  f ! value from the interpolation
-      !!----------------------------------------------------------------------
-      !
-      f = a + x* ( b + x * ( c + d * x ) )
-      !
-   END FUNCTION interp2
-
-
-   FUNCTION interp3( x, a, b, c, d )  RESULT(f)
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE interp1  ***
-      !!
-      !! ** Purpose :   Calculate the first order of deriavtive of
-      !!                a cubic spline function y=a+b*x+c*x^2+d*x^3
-      !!
-      !! ** Method  :   f=dy/dx=b+2*c*x+3*d*x^2
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::  x, a, b, c, d
-      REAL(wp)             ::  f ! value from the interpolation
-      !!----------------------------------------------------------------------
-      !
-      f = b + x * ( 2._wp * c + 3._wp * d * x)
-      !
-   END FUNCTION interp3
-
-
-   FUNCTION integ_spline( xl, xr, a, b, c, d )  RESULT(f)
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE interp1  ***
-      !!
-      !! ** Purpose :   1-d constrained cubic spline integration
-      !!
-      !! ** Method  :  integrate polynomial a+bx+cx^2+dx^3 from xl to xr
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d
-      REAL(wp)             ::  za1, za2, za3
-      REAL(wp)             ::  f                   ! integration result
-      !!----------------------------------------------------------------------
-      !
-      za1 = 0.5_wp * b
-      za2 = c / 3.0_wp
-      za3 = 0.25_wp * d
-      !
-      f  = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - &
-         & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) )
-      !
-   END FUNCTION integ_spline
-
-   !!======================================================================
-END MODULE dynhpg
-
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/dynspg_ts.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/dynspg_ts.F90	(revision 8864)
+++ 	(revision )
@@ -1,1514 +1,0 @@
-MODULE dynspg_ts
-
-   !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out ! 
-
-   !!======================================================================
-   !!                   ***  MODULE  dynspg_ts  ***
-   !! Ocean dynamics:  surface pressure gradient trend, split-explicit scheme
-   !!======================================================================
-   !! History :   1.0  ! 2004-12  (L. Bessieres, G. Madec)  Original code
-   !!              -   ! 2005-11  (V. Garnier, G. Madec)  optimization
-   !!              -   ! 2006-08  (S. Masson)  distributed restart using iom
-   !!             2.0  ! 2007-07  (D. Storkey) calls to BDY routines
-   !!              -   ! 2008-01  (R. Benshila)  change averaging method
-   !!             3.2  ! 2009-07  (R. Benshila, G. Madec) Complete revisit associated to vvl reactivation
-   !!             3.3  ! 2010-09  (D. Storkey, E. O'Dea) update for BDY for Shelf configurations
-   !!             3.3  ! 2011-03  (R. Benshila, R. Hordoir, P. Oddo) update calculation of ub_b
-   !!             3.5  ! 2013-07  (J. Chanut) Switch to Forward-backward time stepping
-   !!             3.6  ! 2013-11  (A. Coward) Update for z-tilde compatibility
-   !!             3.7  ! 2015-11  (J. Chanut) free surface simplification
-   !!              -   ! 2016-12  (G. Madec, E. Clementi) update for Stoke-Drift divergence
-   !!---------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_spg_ts     : compute surface pressure gradient trend using a time-splitting scheme 
-   !!   dyn_spg_ts_init: initialisation of the time-splitting scheme
-   !!   ts_wgt         : set time-splitting weights for temporal averaging (or not)
-   !!   ts_rst         : read/write time-splitting fields in restart file
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE zdf_oce         ! Bottom friction coefts
-   USE sbcisf          ! ice shelf variable (fwfisf)
-   USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE dynadv    , ONLY: ln_dynadv_vec
-   USE phycst          ! physical constants
-   USE dynvor          ! vorticity term
-   USE wet_dry         ! wetting/drying flux limter
-   USE bdy_oce         ! open boundary
-   USE bdytides        ! open boundary condition data
-   USE bdydyn2d        ! open boundary conditions on barotropic variables
-   USE sbctide         ! tides
-   USE updtide         ! tide potential
-   USE sbcwave         ! surface wave
-   !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom             ! IOM library
-   USE restart         ! only for lrst_oce
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing    
-   USE diatmb          ! Top,middle,bottom output
-#if defined key_agrif
-   USE agrif_opa_interp ! agrif
-#endif
-#if defined key_asminc   
-   USE asminc          ! Assimilation increment
-#endif
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dyn_spg_ts        ! routine called in dynspg.F90 
-   PUBLIC dyn_spg_ts_alloc  !    "      "     "    "
-   PUBLIC dyn_spg_ts_init   !    "      "     "    "
-   PUBLIC ts_rst            !    "      "     "    "
-
-   INTEGER, SAVE :: icycle  ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
-   REAL(wp),SAVE :: rdtbt   ! Barotropic time step
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff_f/h at F points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme)
-
-   !! Time filtered arrays at baroclinic time step:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: dynspg_ts.F90 7831 2017-03-24 10:44:55Z jamesharle $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dyn_spg_ts_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  routine dyn_spg_ts_alloc  ***
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr(3)
-      !!----------------------------------------------------------------------
-      ierr(:) = 0
-      !
-      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
-      !
-      IF( ln_dynvor_een )   ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
-         &                            ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(2) )
-         !
-      ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) )
-      !
-      dyn_spg_ts_alloc = MAXVAL( ierr(:) )
-      !
-      IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc )
-      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays')
-      !
-   END FUNCTION dyn_spg_ts_alloc
-
-
-   SUBROUTINE dyn_spg_ts( kt )
-      !!----------------------------------------------------------------------
-      !!
-      !! ** Purpose : - Compute the now trend due to the explicit time stepping
-      !!              of the quasi-linear barotropic system, and add it to the
-      !!              general momentum trend. 
-      !!
-      !! ** Method  : - split-explicit schem (time splitting) :
-      !!      Barotropic variables are advanced from internal time steps
-      !!      "n"   to "n+1" if ln_bt_fw=T
-      !!      or from 
-      !!      "n-1" to "n+1" if ln_bt_fw=F
-      !!      thanks to a generalized forward-backward time stepping (see ref. below).
-      !!
-      !! ** Action :
-      !!      -Update the filtered free surface at step "n+1"      : ssha
-      !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b
-      !!      -Compute barotropic advective velocities at step "n" : un_adv, vn_adv
-      !!      These are used to advect tracers and are compliant with discrete
-      !!      continuity equation taken at the baroclinic time steps. This 
-      !!      ensures tracers conservation.
-      !!      - (ua, va) momentum trend updated with barotropic component.
-      !!
-      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
-      !
-      LOGICAL  ::   ll_fw_start			! if true, forward integration 
-      LOGICAL  ::   ll_init			    ! if true, special startup of 2d equations
-      LOGICAL  ::   ll_tmp1, ll_tmp2            ! local logical variables used in W/D
-      INTEGER  ::   ji, jj, jk, jn   		! dummy loop indices
-      INTEGER  ::   ikbu, ikbv, noffset    	! local integers
-      INTEGER  ::   iktu, iktv             	! local integers
-      REAL(wp) ::   zmdi
-      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf  	! local scalars
-      REAL(wp) ::   zx1, zy1, zx2, zy2          !   -      -
-      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2 	!   -      -
-      REAL(wp) ::   zu_spg, zv_spg              !   -      -
-      REAL(wp) ::   zhura, zhvra         	!   -      -
-      REAL(wp) ::   za0, za1, za2, za3		!   -      -
-      REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_rwd = .True. 
-
-      INTEGER  :: iwdg, jwdg, kwdg   ! short-hand values for the indices of the output point
-
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e
-      REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv
-      REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e
-      REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a
-      REAL(wp), POINTER, DIMENSION(:,:) :: zhf
-      REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy                 ! Wetting/Dying gravity filter coef.
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
-      REAL(wp), POINTER, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts')
-      !
-      !                                         !* Allocate temporary arrays
-      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv )
-      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd)
-      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc)
-      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e)
-      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a                  )
-      CALL wrk_alloc( jpi,jpj,   zhf )
-      IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy )
-      IF( ln_rwd ) CALL wrk_alloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2)
-
-      IF ( ln_wd_diag ) THEN 
-         iwdg = jn_wd_i ; jwdg = jn_wd_j ; kwdg = jn_wd_k
-         WRITE(numout,*) 'kt, iwdg, jwdg, kwdg = ', kt, iwdg, jwdg, kwdg 
-      END IF 
-
-      !
-      zmdi=1.e+20                               !  missing data indicator for masking
-      !                                         !* Local constant initialization
-      z1_12 = 1._wp / 12._wp 
-      z1_8  = 0.125_wp                                   
-      z1_4  = 0.25_wp
-      z1_2  = 0.5_wp     
-      zraur = 1._wp / rau0
-      zwdramp = 1._wp / rn_wdmin1                 ! simplest ramp 
-!     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1)   ! more general ramp
-      !  	                                       ! reciprocal of baroclinic time step 
-      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
-      ELSE                                        ;   z2dt_bf = 2.0_wp * rdt
-      ENDIF
-      z1_2dt_b = 1.0_wp / z2dt_bf 
-      !
-      ll_init     = ln_bt_av                       ! if no time averaging, then no specific restart 
-      ll_fw_start = .FALSE.
-      !                              	            ! time offset in steps for bdy data update
-      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro
-      ELSE                       ;   noffset =   0 
-      ENDIF
-      !
-      IF( kt == nit000 ) THEN             	!* initialisation
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~   free surface with time splitting'
-         IF(lwp) WRITE(numout,*)
-         !
-         IF( neuler == 0 )   ll_init=.TRUE.
-         !
-         IF( ln_bt_fw .OR. neuler == 0 ) THEN
-            ll_fw_start =.TRUE.
-            noffset     = 0
-         ELSE
-            ll_fw_start =.FALSE.
-         ENDIF
-         !
-         ! Set averaging weights and cycle length:
-         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
-         !
-      ENDIF
-      !
-      ! Set arrays to remove/compute coriolis trend.
-      ! Do it once at kt=nit000 if volume is fixed, else at each long time step.
-      ! Note that these arrays are also used during barotropic loop. These are however frozen
-      ! although they should be updated in the variable volume case. Not a big approximation.
-      ! To remove this approximation, copy lines below inside barotropic loop
-      ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step
-      !
-      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN
-         IF( ln_dynvor_een ) THEN               !==  EEN scheme  ==!
-            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
-            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
-                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
-                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-                  END DO
-               END DO
-            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                     &
-                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   )                   &
-                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
-                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
-                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-                  END DO
-               END DO
-            END SELECT
-            CALL lbc_lnk( zwz, 'F', 1._wp )
-            !
-            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-               END DO
-            END DO
-            !
-         ELSE                                !== all other schemes (ENE, ENS, MIX)
-            zwz(:,:) = 0._wp
-            zhf(:,:) = 0._wp
-            
-!!gm  assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed 
-!!gm    A priori a better value should be something like :
-!!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1) 
-!!gm                     divided by the sum of the corresponding mask 
-!!gm 
-!!            
-              IF ( .not. ln_sco ) THEN
-  
-   !!gm  agree the JC comment  : this should be done in a much clear way
-  
-   ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
-   !     Set it to zero for the time being 
-   !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level
-   !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
-   !              ENDIF
-   !              zhf(:,:) = gdepw_0(:,:,jk+1)
-               ELSE
-                 !zhf(:,:) = hbatf(:,:)
-                 DO jj = 1, jpjm1
-                   DO ji = 1, jpim1
-                     zhf(ji,jj) = MAX( 0._wp,                                &
-                                & ( ht_0(ji  ,jj  )*tmask(ji  ,jj  ,1) +     &
-                                &   ht_0(ji+1,jj  )*tmask(ji+1,jj  ,1) +     &
-                                &   ht_0(ji  ,jj+1)*tmask(ji  ,jj+1,1) +     &
-                                &   ht_0(ji+1,jj+1)*tmask(ji+1,jj+1,1) ) /   &
-                                & ( tmask(ji  ,jj  ,1) + tmask(ji+1,jj  ,1) +&
-                                &   tmask(ji  ,jj+1,1) + tmask(ji+1,jj+1,1) +&
-                                &   rsmall  ) )
-                   END DO
-                 END DO
-              END IF
-  
-              DO jj = 1, jpjm1
-                 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
-              END DO
-!!gm end
-
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( zhf, 'F', 1._wp )
-            ! JC: TBC. hf should be greater than 0 
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array
-               END DO
-            END DO
-            zwz(:,:) = ff_f(:,:) * zwz(:,:)
-         ENDIF
-      ENDIF
-      !
-      ! If forward start at previous time step, and centered integration, 
-      ! then update averaging weights:
-      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
-         ll_fw_start=.FALSE.
-         CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
-      ENDIF
-                          
-      ! -----------------------------------------------------------------------------
-      !  Phase 1 : Coupling between general trend and barotropic estimates (1st step)
-      ! -----------------------------------------------------------------------------
-      !      
-      !
-      !                                   !* e3*d/dt(Ua) (Vertically integrated)
-      !                                   ! --------------------------------------------------
-      zu_frc(:,:) = 0._wp
-      zv_frc(:,:) = 0._wp
-      !
-      DO jk = 1, jpkm1
-         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)         
-      END DO
-      !
-      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:)
-      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:)
-      !
-      !
-      !                                   !* baroclinic momentum trend (remove the vertical mean trend)
-      DO jk = 1, jpkm1                    ! -----------------------------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - zu_frc(ji,jj) * umask(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - zv_frc(ji,jj) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      
-!!gm  Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum....
-!!gm  Is it correct to do so ?   I think so...
-      
-      
-      !                                   !* barotropic Coriolis trends (vorticity scheme dependent)
-      !                                   ! --------------------------------------------------------
-      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
-      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)
-      !
-      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               ! energy conserving formulation for planetary vorticity term
-               zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-            END DO
-         END DO
-         !
-      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO
-         END DO
-         !
-      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
-                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
-                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
-                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
-            END DO
-         END DO
-         !
-      ENDIF 
-      !
-      !                                   !* Right-Hand-Side of the barotropic momentum equation
-      !                                   ! ----------------------------------------------------
-      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient
-        IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1 
-                ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
-                     &                                                         > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = ( ABS( sshn(ji+1,jj)             -   sshn(ji  ,jj))  > 1.E-12 ).AND.( &
-                     &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpx(ji,jj) = 1.0_wp
-                ELSE IF(ll_tmp2) THEN
-                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                              &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-                  zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-
-                ELSE
-                  zcpx(ji,jj) = 0._wp
-                END IF
-         
-                ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
-                     &                                                         > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1))  > 1.E-12 ).AND.( &
-                     &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpy(ji,jj) = 1.0_wp
-                ELSE IF(ll_tmp2) THEN
-                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
-                              &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
-                  zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
-
-                ELSE
-                  zcpy(ji,jj) = 0._wp
-                END IF
-              END DO
-           END DO
- 
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1
-                 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
-                        &                        * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
-                 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
-                        &                        * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
-
-              END DO
-           END DO
-
-         ELSE
-
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1   ! vector opt.
-                 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
-                 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
-              END DO
-           END DO
-        ENDIF
-
-      ENDIF
-
-      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
-         DO ji = fs_2, fs_jpim1
-             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
-             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
-          END DO
-      END DO 
-      !
-      !						! Add bottom stress contribution from baroclinic velocities:      
-      IF (ln_bt_fw) THEN
-         DO jj = 2, jpjm1                          
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zwx(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj) ! NOW bottom baroclinic velocities
-               zwy(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj)
-            END DO
-         END DO
-      ELSE
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zwx(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj) ! BEFORE bottom baroclinic velocities
-               zwy(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
-      IF( ln_wd ) THEN
-        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) *  wdrampu(ji,jj)
-        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) *  wdrampv(ji,jj)
-      ELSE
-        zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:)
-        zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:)
-      END IF
-      !
-      !                                         ! Add top stress contribution from baroclinic velocities:      
-      IF( ln_bt_fw ) THEN
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               iktu = miku(ji,jj)
-               iktv = mikv(ji,jj)
-               zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
-               zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
-            END DO
-         END DO
-      ELSE
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               iktu = miku(ji,jj)
-               iktv = mikv(ji,jj)
-               zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
-               zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-      ! Note that the "unclipped" top friction parameter is used even with explicit drag
-      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:)
-      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:)
-      !       
-      IF (ln_bt_fw) THEN                        ! Add wind forcing
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:)
-      ELSE
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:)
-      ENDIF  
-      !
-      IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing
-         IF (ln_bt_fw) THEN
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
-                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
-               END DO
-            END DO
-         ELSE
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
-               END DO
-            END DO
-         ENDIF 
-      ENDIF
-      !                                   !* Right-Hand-Side of the barotropic ssh equation
-      !                                   ! -----------------------------------------------
-      !                                         ! Surface net water flux and rivers
-      IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
-      ELSE
-         zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
-                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
-      ENDIF
-      !
-      IF( ln_sdw ) THEN                         ! Stokes drift divergence added if necessary
-         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
-      ENDIF
-      !
-#if defined key_asminc
-      !                                         ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
-      ENDIF
-#endif
-      !                                   !* Fill boundary data arrays for AGRIF
-      !                                   ! ------------------------------------
-#if defined key_agrif
-         IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
-#endif
-      !
-      ! -----------------------------------------------------------------------
-      !  Phase 2 : Integration of the barotropic equations 
-      ! -----------------------------------------------------------------------
-      !
-      !                                             ! ==================== !
-      !                                             !    Initialisations   !
-      !                                             ! ==================== !  
-      ! Initialize barotropic variables:      
-      IF( ll_init )THEN
-         sshbb_e(:,:) = 0._wp
-         ubb_e  (:,:) = 0._wp
-         vbb_e  (:,:) = 0._wp
-         sshb_e (:,:) = 0._wp
-         ub_e   (:,:) = 0._wp
-         vb_e   (:,:) = 0._wp
-      ENDIF
-
-      !
-      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
-         sshn_e(:,:) =    sshn(:,:)            
-         un_e  (:,:) =    un_b(:,:)            
-         vn_e  (:,:) =    vn_b(:,:)
-         !
-         hu_e  (:,:) =    hu_n(:,:)       
-         hv_e  (:,:) =    hv_n(:,:) 
-         hur_e (:,:) = r1_hu_n(:,:)    
-         hvr_e (:,:) = r1_hv_n(:,:)
-      ELSE                                ! CENTRED integration: start from BEFORE fields
-         sshn_e(:,:) =    sshb(:,:)
-         un_e  (:,:) =    ub_b(:,:)         
-         vn_e  (:,:) =    vb_b(:,:)
-         !
-         hu_e  (:,:) =    hu_b(:,:)       
-         hv_e  (:,:) =    hv_b(:,:) 
-         hur_e (:,:) = r1_hu_b(:,:)    
-         hvr_e (:,:) = r1_hv_b(:,:)
-      ENDIF
-      !
-      !
-      !
-      ! Initialize sums:
-      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)          
-      va_b  (:,:) = 0._wp
-      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level
-      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop
-      vn_adv(:,:) = 0._wp
-      !                                             ! ==================== !
-
-      IF (ln_rwd) THEN
-         zuwdmask(:,:) = 0._wp  ! set to zero for definiteness (not sure this is necessary) 
-         zvwdmask(:,:) = 0._wp  ! 
-         zuwdav2(:,:) =  0._wp 
-         zvwdav2(:,:) =  0._wp   
-      END IF 
-
-
-      DO jn = 1, icycle                             !  sub-time-step loop  !
-         !                                          ! ==================== !
-         !                                                !* Update the forcing (BDY and tides)
-         !                                                !  ------------------
-         ! Update only tidal forcing at open boundaries
-         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 )
-         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, time_offset= noffset   )
-         !
-         ! Set extrapolation coefficients for predictor step:
-         IF ((jn<3).AND.ll_init) THEN      ! Forward           
-           za1 = 1._wp                                          
-           za2 = 0._wp                        
-           za3 = 0._wp                        
-         ELSE                              ! AB3-AM4 Coefficients: bet=0.281105 
-           za1 =  1.781105_wp              ! za1 =   3/2 +   bet
-           za2 = -1.06221_wp               ! za2 = -(1/2 + 2*bet)
-           za3 =  0.281105_wp              ! za3 = bet
-         ENDIF
-
-         ! Extrapolate barotropic velocities at step jit+0.5:
-         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
-         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
-
-         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only)
-            !                                             !  ------------------
-            ! Extrapolate Sea Level at step jit+0.5:
-            zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:)
-            
-            ! set wetting & drying mask at tracer points for this barotropic sub-step 
-            IF ( ln_rwd ) THEN 
-
-               IF ( ln_rwd_rmp ) THEN 
-                  DO jj = 1, jpj                                 
-                     DO ji = 1, jpi   ! vector opt.  
-                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
-!                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin2 ) THEN 
-                           ztwdmask(ji,jj) = 1._wp
-                        ELSE IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
-                           !CEODztwdmask(ji,jj) = ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 ) * zwdramp
-                           ztwdmask(ji,jj) = (tanh(5._wp*( ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )/rn_wdmin1)) ) 
-                        ELSE 
-                           ztwdmask(ji,jj) = 0._wp
-                        END IF
-                     END DO
-                  END DO
-               ELSE
-                  DO jj = 1, jpj                                 
-                     DO ji = 1, jpi   ! vector opt.  
-                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
-                           ztwdmask(ji,jj) = 1._wp
-                        ELSE 
-                           ztwdmask(ji,jj) = 0._wp
-                        END IF
-                     END DO
-                  END DO
-               END IF 
-
-               IF ( ln_wd_diag ) WRITE(numout,*) 'kt, jn = ', kt, jn 
-               IF ( ln_wd_diag ) WRITE(numout, *) 'zsshp2_e: (i,j), (i+1,j), (i,j+1) = ', zsshp2_e(iwdg,jwdg), zsshp2_e(iwdg+1,jwdg), zsshp2_e(iwdg,jwdg+1)
-               IF ( ln_wd_diag ) WRITE(numout, *) 'ht_0:     (i,j), (i+1,j), (i,j+1) = ', ht_0(iwdg,jwdg), ht_0(iwdg+1,jwdg), (iwdg,jwdg+1)
-               IF ( ln_wd_diag ) WRITE(numout, *) 'ztwdmask: (i,j), (i+1,j), (i,j+1) = ', ztwdmask(iwdg,jwdg), ztwdmask(iwdg+1,jwdg), ztwdmask(iwdg,jwdg+1) 
-            END IF 
-           
-
-            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
-               DO ji = 2, fs_jpim1   ! Vector opt.
-                  zwx(ji,jj) = z1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
-                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
-                  zwy(ji,jj) = z1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
-                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp )
-            !
-            zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points
-            zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:)
-         ELSE
-            zhup2_e (:,:) = hu_n(:,:)
-            zhvp2_e (:,:) = hv_n(:,:)
-         ENDIF
-         !                                                !* after ssh
-         !                                                !  -----------
-         ! One should enforce volume conservation at open boundaries here
-         ! considering fluxes below:
-         !
-         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5
-         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
-         !
-#if defined key_agrif
-         ! Set fluxes during predictor step to ensure volume conservation
-         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
-            IF((nbondi == -1).OR.(nbondi == 2)) THEN
-               DO jj=1,jpj
-                  zwx(2,jj) = ubdy_w(jj) * e2u(2,jj)
-               END DO
-            ENDIF
-            IF((nbondi ==  1).OR.(nbondi == 2)) THEN
-               DO jj=1,jpj
-                  zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)
-               END DO
-            ENDIF
-            IF((nbondj == -1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zwy(ji,2) = vbdy_s(ji) * e1v(ji,2)
-               END DO
-            ENDIF
-            IF((nbondj ==  1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2)
-               END DO
-            ENDIF
-         ENDIF
-#endif
-         IF( ln_wd ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt)
-
-         IF ( ln_rwd ) THEN 
-
-            IF ( ln_wd_diag ) THEN 
-               WRITE(numout, *) 'zwx: (i,j), (i+1,j) = ', zwx(iwdg,jwdg), zwx(iwdg+1,jwdg)
-               WRITE(numout, *) 'zwy: (i,j), (i,j+1) = ', zwy(iwdg,jwdg), zwx(iwdg,jwdg+1)
-            END IF 
-
-            DO jj = 1, jpjm1                                 
-               DO ji = 1, jpim1   
-                  IF ( zwx(ji,jj) > 0.0 ) THEN 
-                     zuwdmask(ji, jj) = ztwdmask(ji  ,jj) 
-                  ELSE 
-                     zuwdmask(ji, jj) = ztwdmask(ji+1,jj)  
-                  END IF 
-                  zwx(ji, jj) = zuwdmask(ji,jj)*zwx(ji,jj) 
-
-                  IF ( zwy(ji,jj) > 0.0 ) THEN
-                     zvwdmask(ji, jj) = ztwdmask(ji, jj  )
-                  ELSE 
-                     zvwdmask(ji, jj) = ztwdmask(ji, jj+1)  
-                  END IF 
-                  zwy(ji, jj) = zvwdmask(ji,jj)*zwy(ji,jj) 
-               END DO
-            END DO
-
-            IF ( ln_wd_diag ) THEN 
-               WRITE(numout, *) 'zuwdmask: (i,j)     = ', zuwdmask(iwdg,jwdg)
-               WRITE(numout, *) 'zwx: (i,j)          = ', zwx(iwdg,jwdg)
-               WRITE(numout, *) 'e2u: (i,j)          = ', e2u(iwdg,jwdg)
-               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
-               WRITE(numout, *) 'zhup2_e: (i,j)      = ', zhup2_e(iwdg,jwdg)
-               WRITE(numout, *) 'zvwdmask: (i,j)     = ', zvwdmask(iwdg,jwdg)
-               WRITE(numout, *) 'zwy: (i,j)          = ', zwy(iwdg,jwdg) 
-            END IF 
-
-         END IF    
-         
-         ! Sum over sub-time-steps to compute advective velocities
-         za2 = wgtbtp2(jn)
-         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
-         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
-         
-         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero 
-         IF ( ln_rwd ) THEN
-            zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:)
-            zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:)
-
-            IF ( ln_wd_diag ) THEN 
-               WRITE(numout, *) 'za2, r1_e2u(i,j)     = ', za2, r1_e2u(iwdg,jwdg) 
-               WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
-               WRITE(numout, *) 'zuwdav2: (i,j)       = ', zuwdav2(iwdg,jwdg)
-               WRITE(numout, *) 'zvwdav2: (i,j)       = ', zvwdav2(iwdg,jwdg)
-            END IF 
-
-         END IF 
-
-         ! Set next sea level:
-         DO jj = 2, jpjm1                                 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   &
-                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj)
-            END DO
-         END DO
-         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:)
-         
-         CALL lbc_lnk( ssha_e, 'T',  1._wp )
-
-         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
-         IF( ln_bdy )   CALL bdy_ssh( ssha_e )
-#if defined key_agrif
-         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn )
-#endif
-         !  
-         ! Sea Surface Height at u-,v-points (vvl case only)
-         IF( .NOT.ln_linssh ) THEN                                
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )
-         ENDIF   
-         !                                 
-         ! Half-step back interpolation of SSH for surface pressure computation:
-         !----------------------------------------------------------------------
-         IF ((jn==1).AND.ll_init) THEN
-           za0=1._wp                        ! Forward-backward
-           za1=0._wp                           
-           za2=0._wp
-           za3=0._wp
-         ELSEIF ((jn==2).AND.ll_init) THEN  ! AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
-           za0= 1.0833333333333_wp          ! za0 = 1-gam-eps
-           za1=-0.1666666666666_wp          ! za1 = gam
-           za2= 0.0833333333333_wp          ! za2 = eps
-           za3= 0._wp              
-         ELSE                               ! AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880 
-           za0=0.614_wp                     ! za0 = 1/2 +   gam + 2*eps    
-           za1=0.285_wp                     ! za1 = 1/2 - 2*gam - 3*eps 
-           za2=0.088_wp                     ! za2 = gam
-           za3=0.013_wp                     ! za3 = eps
-         ENDIF
-         !
-         zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) &
-          &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:)
-         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1 
-                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji+1,jj) + ht_wd(ji+1,jj) ) &
-                     &                                                             > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji+1,jj))  > 1.E-12 ).AND.( &
-                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpx(ji,jj) = 1.0_wp
-                ELSE IF(ll_tmp2) THEN
-                  ! no worries about  zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj) = 0, it won't happen ! here
-                  zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) +    ht_wd(ji+1,jj) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
-                              &    / (zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj)) )
-                ELSE
-                  zcpx(ji,jj) = 0._wp
-                END IF
-         
-                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji,jj+1) + ht_wd(ji,jj+1) ) &
-                     &                                                             > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji,jj+1))  > 1.E-12 ).AND.( &
-                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpy(ji,jj) = 1.0_wp
-                ELSE IF(ll_tmp2) THEN
-                  ! no worries about  zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  ) = 0, it won't happen ! here
-                  zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) +    ht_wd(ji,jj+1) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
-                              &    / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  )) )
-                ELSE
-                  zcpy(ji,jj) = 0._wp
-                END IF
-              END DO
-           END DO
-         END IF
-         !
-         ! Compute associated depths at U and V points:
-         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN 	!* Vector form
-            !                                        
-            DO jj = 2, jpjm1                            
-               DO ji = 2, jpim1
-                  zx1 = z1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
-                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
-                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
-                  zy1 = z1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
-                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
-                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
-                  zhust_e(ji,jj) = hu_0(ji,jj) + zx1 
-                  zhvst_e(ji,jj) = hv_0(ji,jj) + zy1
-               END DO
-            END DO
-
-         ENDIF
-         !
-         ! Add Coriolis trend:
-         ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
-         ! at each time step. We however keep them constant here for optimization.
-         ! Recall that zwx and zwy arrays hold fluxes at this stage:
-         ! zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)   ! fluxes at jn+0.5
-         ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
-         !
-         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
-                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
-                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-                  zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-               END DO
-            END DO
-            !
-         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-                  zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-                  zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-               END DO
-            END DO
-            !
-         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
-                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
-                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
-                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
-               END DO
-            END DO
-            ! 
-         ENDIF
-         !
-         ! Add tidal astronomical forcing if defined
-         IF ( ln_tide .AND. ln_tide_pot ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Add bottom stresses:
-!jth do implicitly instead
-!         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
-!         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
-         !
-         ! Add top stresses:
-         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:)
-         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
-         !
-         ! Surface pressure trend:
-
-         IF( ln_wd ) THEN
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1 
-                 ! Add surface pressure gradient
-                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-                 zwx(ji,jj) = zu_spg * zcpx(ji,jj) 
-                 zwy(ji,jj) = zv_spg * zcpy(ji,jj)
-              END DO
-           END DO
-         ELSE
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1   ! vector opt.
-                 ! Add surface pressure gradient
-                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-                 zwx(ji,jj) = zu_spg
-                 zwy(ji,jj) = zv_spg
-              END DO
-           END DO
-         END IF
-
-         !
-         ! Set next velocities:
-         IF( ln_dynadv_vec .OR. ln_linssh ) THEN 	!* Vector form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
-                            &     + rdtbt * (                      zwx(ji,jj)   &
-                            &                                 + zu_trd(ji,jj)   &
-                            &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * ssumask(ji,jj)
-
-                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
-                            &     + rdtbt * (                      zwy(ji,jj)   &
-                            &                                 + zv_trd(ji,jj)   &
-                            &                                 + zv_frc(ji,jj) ) &
-                            &   ) * ssvmask(ji,jj)
- 
-!jth implicit bottom friction:
-               ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * bfrua(ji,jj) * hur_e(ji,jj))
-               va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * bfrva(ji,jj) * hvr_e(ji,jj))
-
-               END DO
-            END DO
-            !
-         ELSE					 	                     !* Flux form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-
-                  IF( ln_wd ) THEN
-!CEOD                    zhura = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1)
-!CEOD                    zhvra = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1)
-                    zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
-                    zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
-                  ELSE
-                    zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
-                    zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
-                  END IF
-                  zhura = ssumask(ji,jj)/(zhura + 1._wp - ssumask(ji,jj))
-                  zhvra = ssvmask(ji,jj)/(zhvra + 1._wp - ssvmask(ji,jj))
-
-                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   & 
-                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   & 
-                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   &
-                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) &
-                            &   ) * zhura
-
-                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   &
-                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   &
-                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   &
-                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) &
-                            &   ) * zhvra
-               END DO
-            END DO
-         ENDIF
-
-         IF ( ln_rwd) THEN 
-            IF ( ln_wd_diag ) THEN 
-               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
-               WRITE(numout, *) 'va_e: (i,j)         = ', va_e(iwdg,jwdg)
-            END IF 
-            ua_e(:,:) = ua_e(:,:) * zuwdmask(:,:) 
-            va_e(:,:) = va_e(:,:) * zvwdmask(:,:) 
-            IF ( ln_wd_diag ) THEN 
-               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
-               WRITE(numout, *) 'va_e: (i,j)         = ', va_e(iwdg,jwdg)
-            END IF 
-         END IF 
-
-         
-         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only)
-            IF( ln_wd ) THEN
-!CEOD              hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1)
-!CEOD              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1)
-              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
-              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
-            ELSE
-              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
-              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
-            END IF
-            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) )
-            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) )
-            !
-         ENDIF
-         !                                             !* domain lateral boundary
-         CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
-         !
-         !                                                 ! open boundaries
-         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
-#if defined key_agrif                                                           
-         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif
-#endif
-         !                                             !* Swap
-         !                                             !  ----
-         ubb_e  (:,:) = ub_e  (:,:)
-         ub_e   (:,:) = un_e  (:,:)
-         un_e   (:,:) = ua_e  (:,:)
-         !
-         vbb_e  (:,:) = vb_e  (:,:)
-         vb_e   (:,:) = vn_e  (:,:)
-         vn_e   (:,:) = va_e  (:,:)
-         !
-         sshbb_e(:,:) = sshb_e(:,:)
-         sshb_e (:,:) = sshn_e(:,:)
-         sshn_e (:,:) = ssha_e(:,:)
-
-         !                                             !* Sum over whole bt loop
-         !                                             !  ----------------------
-         za1 = wgtbtp1(jn)                                    
-         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
-         ELSE                                              ! Sum transports
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
-         ENDIF
-         !                       			   ! Sum sea level
-         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
-
-         !                                                 ! ==================== !
-      END DO                                               !        end loop      !
-      !                                                    ! ==================== !
-      ! -----------------------------------------------------------------------------
-      ! Phase 3. update the general trend with the barotropic trend
-      ! -----------------------------------------------------------------------------
-      !
-      ! Set advection velocity correction:
-      zwx(:,:) = un_adv(:,:)
-      zwy(:,:) = vn_adv(:,:)
-      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN     
-         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:)
-         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:)
-      ELSE
-         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)
-         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)
-      END IF
-
-      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation
-         ub2_b(:,:) = zwx(:,:)
-         vb2_b(:,:) = zwy(:,:)
-      ENDIF
-
-      IF ( ln_wd_diag ) THEN 
-         WRITE(numout, *) 'ub2_b: (i,j)        = ', ub2_b(iwdg,jwdg)
-         WRITE(numout, *) 'r1_hu_n: (i,j)      = ', r1_hu_n(iwdg,jwdg)
-         WRITE(numout, *) 'zwx: (i,j)          = ', zwx(iwdg,jwdg)
-         WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
-      END IF 
-
-      !
-      ! Update barotropic trend:
-      IF( ln_dynadv_vec .OR. ln_linssh ) THEN
-         DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b
-         END DO
-      ELSE
-         ! At this stage, ssha has been corrected: compute new depths at velocity points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
-                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    &
-                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
-                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    &
-                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
-            END DO
-         END DO
-         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
-         !
-         DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b
-         END DO
-         ! Save barotropic velocities not transport:
-         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
-         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
-      ENDIF
-
-      IF ( ln_wd_diag ) THEN 
-         WRITE(numout, *) 'ua_b: (i,j) A        = ', ua_b(iwdg,jwdg)
-         WRITE(numout, *) 'va_b: (i,j) B        = ', va_b(iwdg,jwdg)
-      END IF 
-
-! temporary debugging code 
-      IF ( ln_wd_diag ) THEN 
-         WRITE(numout, *) 'ua: (i,j,k)  B       = ', ua(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'ua_b: (i,j)  B       = ', ua_b(iwdg,jwdg)
-         WRITE(numout, *) 'un: (i,j,k)          = ', un(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'un_b: (i,j)          = ', un_b(iwdg,jwdg)
-         WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
-         WRITE(numout, *) 'va: (i,j,k)          = ', va(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'va_b: (i,j,k)        = ', va_b(iwdg,jwdg)
-         WRITE(numout, *) 'vn: (i,j,k)          = ', vn(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'vn_b: (i,j)          = ', vn_b(iwdg,jwdg)
-         WRITE(numout, *) 'vn_adv: (i,j)        = ', vn_adv(iwdg,jwdg)
-      END IF 
-
-      ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)  
-      DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
-      END DO
-
-      IF ( ln_rwd .and. ln_rwd_bc) THEN 
-         DO jk = 1, jpkm1
-            un(:,:,jk) = ( un_adv(:,:) + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)) ) * umask(:,:,jk) 
-            vn(:,:,jk) = ( vn_adv(:,:) + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)) ) * vmask(:,:,jk)  
-         END DO
-      END IF 
-
-      IF ( ln_wd_diag ) THEN 
-         WRITE(numout, *) 'ua: (i,j,k)          = ', ua(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'ua_b: (i,j,k)        = ', ua_b(iwdg,jwdg)
-         WRITE(numout, *) 'un: (i,j,k)          = ', un(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'va: (i,j,k)          = ', va(iwdg,jwdg,kwdg)
-         WRITE(numout, *) 'va_b: (i,j,k)        = ', va_b(iwdg,jwdg)
-         WRITE(numout, *) 'vn: (i,j,k)          = ', vn(iwdg,jwdg,kwdg)
-      END IF 
-      
-      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
-      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current
-      !
-#if defined key_agrif
-      ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports at next time step)
-      !
-      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
-         IF( Agrif_NbStepint() == 0 ) THEN
-            ub2_i_b(:,:) = 0._wp
-            vb2_i_b(:,:) = 0._wp
-         END IF
-         !
-         za1 = 1._wp / REAL(Agrif_rhot(), wp)
-         ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:)
-         vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:)
-      ENDIF
-#endif      
-      !                                   !* write time-spliting arrays in the restart
-      IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' )
-      !
-      CALL wrk_dealloc( jpi,jpj,   zsshp2_e, zhdiv )
-      CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd )
-      CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc )
-      CALL wrk_dealloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e )
-      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a                                   )
-      CALL wrk_dealloc( jpi,jpj,   zhf )
-      IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )
-      IF( ln_rwd ) CALL wrk_dealloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 )
-      !
-      IF ( ln_diatmb ) THEN
-         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity
-         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity
-      ENDIF
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts')
-      !
-   END SUBROUTINE dyn_spg_ts
-
-
-   SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2)
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE ts_wgt  ***
-      !!
-      !! ** Purpose : Set time-splitting weights for temporal averaging (or not)
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in) ::   ll_av      ! temporal averaging=.true.
-      LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
-      INTEGER, INTENT(inout) :: jpit      ! cycle length    
-      REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights
-                                                         zwgt2    ! Secondary weights
-      
-      INTEGER ::  jic, jn, ji                      ! temporary integers
-      REAL(wp) :: za1, za2
-      !!----------------------------------------------------------------------
-
-      zwgt1(:) = 0._wp
-      zwgt2(:) = 0._wp
-
-      ! Set time index when averaged value is requested
-      IF (ll_fw) THEN 
-         jic = nn_baro
-      ELSE
-         jic = 2 * nn_baro
-      ENDIF
-
-      ! Set primary weights:
-      IF (ll_av) THEN
-           ! Define simple boxcar window for primary weights 
-           ! (width = nn_baro, centered around jic)     
-         SELECT CASE ( nn_bt_flt )
-              CASE( 0 )  ! No averaging
-                 zwgt1(jic) = 1._wp
-                 jpit = jic
-
-              CASE( 1 )  ! Boxcar, width = nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
-                    IF (za1 < 0.5_wp) THEN
-                      zwgt1(jn) = 1._wp
-                      jpit = jn
-                    ENDIF
-                 ENDDO
-
-              CASE( 2 )  ! Boxcar, width = 2 * nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
-                    IF (za1 < 1._wp) THEN
-                      zwgt1(jn) = 1._wp
-                      jpit = jn
-                    ENDIF
-                 ENDDO
-              CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt' )
-         END SELECT
-
-      ELSE ! No time averaging
-         zwgt1(jic) = 1._wp
-         jpit = jic
-      ENDIF
-    
-      ! Set secondary weights
-      DO jn = 1, jpit
-        DO ji = jn, jpit
-             zwgt2(jn) = zwgt2(jn) + zwgt1(ji)
-        END DO
-      END DO
-
-      ! Normalize weigths:
-      za1 = 1._wp / SUM(zwgt1(1:jpit))
-      za2 = 1._wp / SUM(zwgt2(1:jpit))
-      DO jn = 1, jpit
-        zwgt1(jn) = zwgt1(jn) * za1
-        zwgt2(jn) = zwgt2(jn) * za2
-      END DO
-      !
-   END SUBROUTINE ts_wgt
-
-
-   SUBROUTINE ts_rst( kt, cdrw )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE ts_rst  ***
-      !!
-      !! ** Purpose : Read or write time-splitting arrays in restart file
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-      !
-      !!----------------------------------------------------------------------
-      !
-      IF( TRIM(cdrw) == 'READ' ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:) )   
-         CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:) ) 
-         IF( .NOT.ln_bt_av ) THEN
-            CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:) )   
-            CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:) )   
-            CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:) )
-            CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:) ) 
-            CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:) )   
-            CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:) )
-         ENDIF
-#if defined key_agrif
-         ! Read time integrated fluxes
-         IF ( .NOT.Agrif_Root() ) THEN
-            CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:) )   
-            CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:) )
-         ENDIF
-#endif
-      !
-      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
-         CALL iom_rstput( kt, nitrst, numrow, 'ub2_b'   , ub2_b  (:,:) )
-         CALL iom_rstput( kt, nitrst, numrow, 'vb2_b'   , vb2_b  (:,:) )
-         !
-         IF (.NOT.ln_bt_av) THEN
-            CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e'  , sshbb_e(:,:) ) 
-            CALL iom_rstput( kt, nitrst, numrow, 'ubb_e'    ,   ubb_e(:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'vbb_e'    ,   vbb_e(:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'sshb_e'   ,  sshb_e(:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'ub_e'     ,    ub_e(:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'vb_e'     ,    vb_e(:,:) )
-         ENDIF
-#if defined key_agrif
-         ! Save time integrated fluxes
-         IF ( .NOT.Agrif_Root() ) THEN
-            CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b'  , ub2_i_b(:,:) )
-            CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b'  , vb2_i_b(:,:) )
-         ENDIF
-#endif
-      ENDIF
-      !
-   END SUBROUTINE ts_rst
-
-
-   SUBROUTINE dyn_spg_ts_init
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE dyn_spg_ts_init  ***
-      !!
-      !! ** Purpose : Set time splitting options
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji ,jj              ! dummy loop indices
-      REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zcu
-      !!----------------------------------------------------------------------
-      !
-      ! Max courant number for ext. grav. waves
-      !
-      CALL wrk_alloc( jpi,jpj,   zcu )
-      !
-      DO jj = 1, jpj
-         DO ji =1, jpi
-            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
-            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
-            zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
-         END DO
-      END DO
-      !
-      zcmax = MAXVAL( zcu(:,:) )
-      IF( lk_mpp )   CALL mpp_max( zcmax )
-
-      ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
-      IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
-      
-      rdtbt = rdt / REAL( nn_baro , wp )
-      zcmax = zcmax * rdtbt
-							! Print results
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      IF( ln_bt_auto ) THEN
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.true. Automatically set nn_baro '
-         IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax
-      ELSE
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist '
-      ENDIF
-
-      IF(ln_bt_av) THEN
-         IF(lwp) WRITE(numout,*) '     ln_bt_av=.true.  => Time averaging over nn_baro time steps is on '
-      ELSE
-         IF(lwp) WRITE(numout,*) '     ln_bt_av=.false. => No time averaging of barotropic variables '
-      ENDIF
-      !
-      !
-      IF(ln_bt_fw) THEN
-         IF(lwp) WRITE(numout,*) '     ln_bt_fw=.true.  => Forward integration of barotropic variables '
-      ELSE
-         IF(lwp) WRITE(numout,*) '     ln_bt_fw =.false.=> Centred integration of barotropic variables '
-      ENDIF
-      !
-#if defined key_agrif
-      ! Restrict the use of Agrif to the forward case only
-      IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )
-#endif
-      !
-      IF(lwp) WRITE(numout,*)    '     Time filter choice, nn_bt_flt: ', nn_bt_flt
-      SELECT CASE ( nn_bt_flt )
-         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac'
-         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
-         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
-         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' )
-      END SELECT
-      !
-      IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) '     nn_baro = ', nn_baro
-      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rdtbt
-      IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax
-      !
-      IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN
-         CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' )
-      ENDIF
-      IF( zcmax>0.9_wp ) THEN
-         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )          
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj,   zcu )
-      !
-   END SUBROUTINE dyn_spg_ts_init
-
-   !!======================================================================
-END MODULE dynspg_ts
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/stpctl.F90	(revision 8865)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/stpctl.F90	(revision 8865)
@@ -0,0 +1,194 @@
+MODULE stpctl
+   !!======================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!======================================================================
+   !! History :  OPA  ! 1991-03  (G. Madec) Original code
+   !!            6.0  ! 1992-06  (M. Imbard)
+   !!            8.0  ! 1997-06  (A.M. Treguier)
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE c1d             ! 1D vertical configuration
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+   USE lib_fortran     ! Fortran routines library 
+!   USE wet_dry,  ONLY: ln_wd, ln_rwd , rn_ssh_ref    ! reference depth for negative bathy
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_ctl           ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: stpctl.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!              - Stop the run IF problem ( indic < 0 )
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic   ! error indicator
+      !!
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ii, ij, ik             ! local integers
+      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
+      INTEGER, DIMENSION(3) ::   ilocu     ! 
+      INTEGER, DIMENSION(2) ::   ilocs     ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      !
+      !                                              !* Test maximum of velocity (zonal only)
+      !                                              !  ------------------------
+      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
+      zumax = 0.e0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
+          END DO 
+        END DO 
+      END DO        
+      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      !
+      IF( zumax > 20.e0 ) THEN
+         IF( lk_mpp ) THEN
+            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+         ELSE
+            ilocu = MAXLOC( ABS( un(:,:,:) ) )
+            ii = ilocu(1) + nimpp - 1
+            ij = ilocu(2) + njmpp - 1
+            ik = ilocu(3)
+         ENDIF
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' ====== '
+            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+      !
+      !                                              !* Test minimum of salinity
+      !                                              !  ------------------------
+      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
+      zsmin = 100._wp
+      DO jj = 2, jpjm1
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
+      !
+      IF( zsmin < 0.) THEN 
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9500) kt, zsmin, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
+      !
+      !
+      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
+
+      ! log file (ssh statistics)
+      ! --------                                   !* ssh statistics (and others...)
+      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      zsshmax = 0.e0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+!            IF( (ln_wd .OR. ln_rwd)) THEN
+!               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)+rn_ssh_ref) )
+!            ELSE
+               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
+!            ENDIF
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
+      !
+      IF( zsshmax > 10.e0 ) THEN 
+         IF (lk_mpp) THEN
+            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
+         ELSE
+            ilocs = MAXLOC( ABS(sshn(:,:)) )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9600) kt, zsshmax, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
+      !
+      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
+      !
+      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
+      !
+9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
+      !
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90	(revision 8865)
@@ -171,5 +171,5 @@
 
 ! subtract the height of z=0 above the geoid (this allows z = 0 to be higher than all points that may become wet)   
-      pssh(:,:) = pssh(:,:) - rn_ssh_ref
+      pssh(:,:) = pssh(:,:)  - rn_ssh_ref
 
       !
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90	(revision 8865)
@@ -16,8 +16,8 @@
    USE oce            ! ocean variables
    USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco   ! ocean space and time domain
-   USE dom_oce ,  ONLY: mi0, mi1, nimpp, njmpp,  &
-                      & mj0, mj1, glamt, gphit   ! ocean space and time domain
+   USE dom_oce ,  ONLY: ht_0,mi0, mi1, nimpp, njmpp,  &
+                      & mj0, mj1, glamt, gphit, ht_0   ! ocean space and time domain
    USE usrdef_nam     ! User defined : namelist variables
-   USE wet_dry ,  ONLY: rn_wdmin1, rn_wdmin2, rn_wdld, ht_wd, rn_ht_0,rn_ssh_ref
+   USE wet_dry ,  ONLY: rn_wdmin1, rn_wdmin2, rn_wdld,  rn_ht_0,rn_ssh_ref
    !
    USE in_out_manager ! I/O manager
@@ -234,5 +234,6 @@
               
 ! increase the depth of the bathymetry by rn_ssh_ref and rn_ht_0   
-      zht(:,:) = zht(:,:) + rn_ssh_ref + rn_ht_0  
+      !zht(:,:) = zht(:,:) + rn_ssh_ref + rn_ht_0  
+      !zht(:,:) = zht(:,:) + rn_ssh_ref + rn_ht_0  
 
       ! at u-point: averaging zht
@@ -285,5 +286,5 @@
       IF ( ln_sco ) THEN      !==  s-coordinate  ==!   (terrain-following coordinate)
          !
-         ht_wd = zht
+         ht_0 = zht
          k_bot(:,:) = jpkm1 * k_top(:,:)  !* bottom ocean = jpk-1 (here use k_top as a land mask)
          DO jj = 1, jpj
Index: anches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/wet_dry.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/wet_dry.F90	(revision 8864)
+++ 	(revision )
@@ -1,457 +1,0 @@
-MODULE wet_dry
-
-   !! includes updates to namelist namwad for diagnostic outputs of ROMS wetting and drying
-
-   !!==============================================================================
-   !!                       ***  MODULE  wet_dry  ***
-   !! Wetting and drying includes initialisation routine and routines to
-   !! compute and apply flux limiters and preserve water depth positivity
-   !! only effects if wetting/drying is on (ln_wd == .true.)
-   !!==============================================================================
-   !! History :  3.6  ! 2014-09  ((H.Liu)  Original code
-   !!                 ! will add the runoff and periodic BC case later
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   wad_lmt    : Compute the horizontal flux limiter and the limited velocity
-   !!                when wetting and drying happens 
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoff 
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !!----------------------------------------------------------------------
-   !! critical depths,filters, limiters,and masks for  Wetting and Drying
-   !! ---------------------------------------------------------------------
-
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter 
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd          !: wetting and drying t-pt depths
-                                                                     !  (can include negative depths)
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdramp, wdrampu, wdrampv ! for hpg limiting
-
-   LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off)
-   REAL(wp), PUBLIC  ::   rn_wdmin0   !: depth at which wetting/drying starts
-   LOGICAL,  PUBLIC  ::   ln_rwd      !: ROMS Wetting/drying activation switch (T:on,F:off)
-   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells
-   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerance of minimum water depth on dried cells
-   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying 
-                                           !: will be considered
-   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
-   LOGICAL,  PUBLIC  ::   ln_rwd_bc   !: ROMS scheme: True implies 3D velocities are set to the barotropic values at points 
-                                      !: where the flow is from wet points on less than half the barotropic sub-steps  
-   LOGICAL,  PUBLIC  ::   ln_rwd_rmp  !: use a ramp for the rwd flux limiter between 2 rn_wdmin1 and rn_wdmin1 (rather than a cut-off at rn_wdmin1)      
-   REAL(wp), PUBLIC  ::   rn_ssh_ref  !: height of z=0 with respect to the geoid; 
-   REAL(wp), PUBLIC  ::   rn_ht_0     !: the height at which ht_0 = 0   
-
-   LOGICAL,  PUBLIC  ::   ln_wd_diag  ! True implies wad diagnostic at chosen point are printed out
-   INTEGER , PUBLIC  ::   jn_wd_i, jn_wd_j, jn_wd_k   ! indices at which diagnostic outputs are generated 
-
-   PUBLIC   wad_init                  ! initialisation routine called by step.F90
-   PUBLIC   wad_lmt                   ! routine called by sshwzv.F90
-   PUBLIC   wad_lmt_bt                ! routine called by dynspg_ts.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-CONTAINS
-
-   SUBROUTINE wad_init
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE wad_init  ***
-      !!                    
-      !! ** Purpose :   read wetting and drying namelist and print the variables.
-      !!
-      !! ** input   : - namwad namelist
-      !!----------------------------------------------------------------------
-      NAMELIST/namwad/ ln_wd, ln_rwd, rn_wdmin0, ln_rwd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit, ln_wd_diag, ln_rwd_bc, &
-                     & rn_ssh_ref, rn_ht_0, jn_wd_i, jn_wd_j, jn_wd_k,ln_rwd_rmp
-
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      INTEGER  ::   ierr                ! Local integer status array allocation 
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namwad in reference namelist 
-                                        ! : Parameters for Wetting/Drying
-      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.) 
-      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist 
-                                        ! : Parameters for Wetting/Drying
-      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. )
-      IF(lwm) WRITE ( numond, namwad )
-
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~~'
-         WRITE(numout,*) '   Namelist namwad'
-         WRITE(numout,*) '      Logical for NOC  wd scheme         ln_wd      = ', ln_wd
-         WRITE(numout,*) '      Logical for ROMS wd scheme         ln_rwd     = ', ln_rwd
-         WRITE(numout,*) '      Depth at which wet/drying starts rn_wdmin0    = ', rn_wdmin0
-         WRITE(numout,*) '      Minimum wet depth on dried cells rn_wdmin1    = ', rn_wdmin1
-         WRITE(numout,*) '      Tolerance of min wet depth     rn_wdmin2      = ', rn_wdmin2
-         WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld
-         WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit
-         WRITE(numout,*) '      Logical for WAD diagnostics      ln_wd_diag   = ', ln_wd_diag
-         WRITE(numout,*) '      T => baroclinic u,v = 0 at dry pts: ln_rwd_bc = ', ln_rwd_bc     
-         WRITE(numout,*) '      use a ramp for rwd limiter:      ln_rwd_rmp   = ', ln_rwd_rmp
-         WRITE(numout,*) '      height of z = 0 above the geoid: rn_ssh_ref   = ', rn_ssh_ref
-         WRITE(numout,*) '      the height (z) at which ht_0 = 0:rn_ht_0      = ', rn_ht_0  
-         WRITE(numout,*) '      i-index for diagnostic point     jn_wd_i      = ', jn_wd_i
-         WRITE(numout,*) '      j-index for diagnostic point     jn_wd_j      = ', jn_wd_j
-         WRITE(numout,*) '      k-index for diagnostic point     jn_wd_k      = ', jn_wd_k
-      ENDIF
-      !
-! CEOD .OR. ln_rwd added to prevent segmentation errors 
-      IF(ln_wd .OR. ln_rwd) THEN
-         ALLOCATE( wdmask(jpi,jpj), ht_wd(jpi,jpj),  STAT=ierr )
-         ALLOCATE( wdramp(jpi,jpj), wdrampu(jpi,jpj), wdrampv(jpi,jpj), STAT=ierr ) 
-         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
-      ENDIF
-      !
-   END SUBROUTINE wad_init
-
-
-   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE wad_lmt  ***
-      !!                    
-      !! ** Purpose :   generate flux limiters for wetting/drying
-      !!
-      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
-      !!
-      !! ** Action  : - calculate flux limiter and W/D flag
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1
-      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   sshemp
-      REAL(wp), INTENT(in) :: z2dt
-      !
-      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
-      INTEGER  ::   jflag               ! local scalar
-      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
-      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
-      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
-      REAL(wp) ::   ztmp                ! local scalars
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
-      !!----------------------------------------------------------------------
-      !
-
-      IF( nn_timing == 1 )  CALL timing_start('wad_lmt')
-
-      IF(ln_wd) THEN
-
-        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
-        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
-        !
-       
-        !IF(lwp) WRITE(numout,*)
-        !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting'
-       
-        jflag  = 0
-        zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen
-
-       
-        zflxp(:,:)   = 0._wp
-        zflxn(:,:)   = 0._wp
-        zflxu(:,:)   = 0._wp
-        zflxv(:,:)   = 0._wp
-
-        zwdlmtu(:,:)  = 1._wp
-        zwdlmtv(:,:)  = 1._wp
-       
-        ! Horizontal Flux in u and v direction
-        DO jk = 1, jpkm1  
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
-                 zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
-              END DO  
-           END DO  
-        END DO
-       
-        zflxu(:,:) = zflxu(:,:) * e2u(:,:)
-        zflxv(:,:) = zflxv(:,:) * e1v(:,:)
-       
-        wdmask(:,:) = 1
-        DO jj = 2, jpj
-           DO ji = 2, jpi 
-
-             IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE   ! we don't care about land cells
-             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
-
-              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
-                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
-              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
-                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
-
-              zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1
-              IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary
-                sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
-                IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
-                IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
-                IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
-                wdmask(ji,jj) = 0._wp
-              END IF
-           ENDDO
-        END DO
-
-
-! slwa
-! HPG limiter from jholt
-      wdramp(:,:) = min((ht_wd(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
-!      write(6,*)'wdramp ',wdramp(10,10),wdramp(10,11)
-!jth assume don't need a lbc_lnk here
-       DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-           wdrampu(ji,jj) = min(wdramp(ji,jj),wdramp(ji+1,jj))
-           wdrampv(ji,jj) = min(wdramp(ji,jj),wdramp(ji,jj+1))
-         ENDDO
-       ENDDO
-        !wdrampu(:,:)=1.0_wp
-        !wdrampv(:,:)=1.0_wp
-! end HPG limiter
-
-
-      
-        !! start limiter iterations 
-        DO jk1 = 1, nn_wdit + 1
-       
-          
-           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
-           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
-           jflag = 0     ! flag indicating if any further iterations are needed
-          
-           DO jj = 2, jpj
-              DO ji = 2, jpi 
-        
-                 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 
-                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
-        
-                 ztmp = e1e2t(ji,jj)
-
-                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
-                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
-                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
-                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
-          
-                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-                 zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
-          
-                 IF( zdep1 > zdep2 ) THEN
-                   wdmask(ji, jj) = 0
-                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                   !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                   ! flag if the limiter has been used but stop flagging if the only
-                   ! changes have zeroed the coefficient since further iterations will
-                   ! not change anything
-                   IF( zcoef > 0._wp ) THEN
-                      jflag = 1 
-                   ELSE
-                      zcoef = 0._wp
-                   ENDIF
-                   IF(jk1 > nn_wdit) zcoef = 0._wp
-                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
-                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
-                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
-                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
-                 END IF
-              END DO ! ji loop
-           END DO  ! jj loop
-
-           CALL lbc_lnk( zwdlmtu, 'U', 1. )
-           CALL lbc_lnk( zwdlmtv, 'V', 1. )
-
-           IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain
-
-           IF(jflag == 0) EXIT
-          
-        END DO  ! jk1 loop
-       
-        DO jk = 1, jpkm1
-          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :) 
-          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :) 
-        END DO
-
-        CALL lbc_lnk( un, 'U', -1. )
-        CALL lbc_lnk( vn, 'V', -1. )
-      !
-        un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
-        vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
-        CALL lbc_lnk( un_b, 'U', -1. )
-        CALL lbc_lnk( vn_b, 'V', -1. )
-       
-        IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
-       
-        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
-        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
-        !
-        !
-        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
-        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
-        !
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
-      !
-   END SUBROUTINE wad_lmt
-
-
-   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE wad_lmt  ***
-      !!                    
-      !! ** Purpose :   limiting flux in the barotropic stepping (dynspg_ts)
-      !!
-      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
-      !!
-      !! ** Action  : - calculate flux limiter and W/D flag
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in)    ::   rdtbt    ! ocean time-step index
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc  
-      !
-      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
-      INTEGER  ::   jflag               ! local scalar
-      REAL(wp) ::   z2dt
-      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
-      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
-      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
-      REAL(wp) ::   ztmp                ! local scalars
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt')
-
-      IF(ln_wd) THEN
-
-        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
-        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
-        !
-       
-        !IF(lwp) WRITE(numout,*)
-        !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting'
-       
-        jflag  = 0
-        zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes
-
-        z2dt = rdtbt   
-       
-        zflxp(:,:)   = 0._wp
-        zflxn(:,:)   = 0._wp
-
-        zwdlmtu(:,:)  = 1._wp
-        zwdlmtv(:,:)  = 1._wp
-       
-        ! Horizontal Flux in u and v direction
-       
-        DO jj = 2, jpj
-           DO ji = 2, jpi 
-
-             IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
-             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
-
-              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
-                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
-              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
-                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
-
-              zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
-              IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary
-                sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
-                IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
-                IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
-                IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
-              END IF
-           ENDDO
-        END DO
-
-      
-        !! start limiter iterations 
-        DO jk1 = 1, nn_wdit + 1
-       
-          
-           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
-           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
-           jflag = 0     ! flag indicating if any further iterations are needed
-          
-           DO jj = 2, jpj
-              DO ji = 2, jpi 
-        
-                 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE 
-                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
-        
-                 ztmp = e1e2t(ji,jj)
-
-                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
-                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
-                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
-                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
-          
-                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-                 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
-          
-                 IF(zdep1 > zdep2) THEN
-                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                   !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                   ! flag if the limiter has been used but stop flagging if the only
-                   ! changes have zeroed the coefficient since further iterations will
-                   ! not change anything
-                   IF( zcoef > 0._wp ) THEN
-                      jflag = 1 
-                   ELSE
-                      zcoef = 0._wp
-                   ENDIF
-                   IF(jk1 > nn_wdit) zcoef = 0._wp
-                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
-                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
-                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
-                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
-                 END IF
-              END DO ! ji loop
-           END DO  ! jj loop
-
-           CALL lbc_lnk( zwdlmtu, 'U', 1. )
-           CALL lbc_lnk( zwdlmtv, 'V', 1. )
-
-           IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain
-
-           IF(jflag == 0) EXIT
-          
-        END DO  ! jk1 loop
-       
-        zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 
-        zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 
-
-        CALL lbc_lnk( zflxu, 'U', -1. )
-        CALL lbc_lnk( zflxv, 'V', -1. )
-       
-        IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
-       
-        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
-        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
-        !
-        !
-        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
-        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
-        !
-      END IF
-
-      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
-   END SUBROUTINE wad_lmt_bt
-
-   !!==============================================================================
-END MODULE wet_dry
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/cfg.txt
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/cfg.txt	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/cfg.txt	(revision 8865)
@@ -10,2 +10,3 @@
 WAD7 OPA_SRC
 WAD7LONG OPA_SRC
+WAD2 OPA_SRC
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 8865)
@@ -21,4 +21,5 @@
    USE phycst          ! physical constants
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wet_dry         ! Use wet dry to get reference ssh level
    USE in_out_manager  !
 
@@ -169,5 +170,9 @@
          ii = idx%nbi(jb,igrd)
          ij = idx%nbj(jb,igrd)
-         spgu(ii, ij) = dta%ssh(jb)
+         IF( ln_wd .OR. ln_rwd ) THEN
+            spgu(ii, ij) = dta%ssh(jb)  - rn_ssh_ref 
+         ELSE
+            spgu(ii, ij) = dta%ssh(jb)
+         ENDIF
       END DO
 
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8865)
@@ -154,7 +154,12 @@
          CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
 
-      CALL iom_put( "ssh" , sshn )                 ! sea surface height
+      IF( (ln_wd .OR. ln_rwd)) THEN
+         CALL iom_put( "ssh" , sshn+rn_ssh_ref )                 ! sea surface height !bring it back to the reference need wad if here
+      ELSE
+         CALL iom_put( "ssh" , sshn )                 ! sea surface height !bring it back to the reference need wad if here
+      ENDIF
+
       IF( iom_use("wetdep") )   &                  ! wet depth
-         CALL iom_put( "wetdep" , ht_wd(:,:) + sshn(:,:) )
+         CALL iom_put( "wetdep" , ht_0(:,:) + sshn(:,:) )
       
       CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 8865)
@@ -674,7 +674,6 @@
       ENDIF
       !
-      IF( ln_wd ) THEN              ! wetting and drying domain
+      IF( ln_wd  .or. ln_rwd ) THEN              ! wetting and drying domain
          CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
-         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
       ENDIF
       !
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 8865)
@@ -876,37 +876,48 @@
          ELSE                                   !* Initialize at "rest"
             !
-            IF( ln_wd .AND. ( cn_cfg == 'wad' ) ) THEN
+
+! MJB ln_rwd edits start here - these are essential 
+
+            IF( (ln_wd .OR. ln_rwd)) THEN 
+
               ! Wetting and drying test case
-              CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )
-                       tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
-                       sshn (:,:)     = sshb(:,:)
-                       un   (:,:,:)   = ub  (:,:,:)
-                       vn   (:,:,:)   = vb  (:,:,:)
-                                                ! uniform T-S fields and initial ssh slope
-               ! needs to be called here and in istate which is called later.
-               ! Adjust vertical metrics
+               IF( cn_cfg == 'wad' ) THEN
+                  CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )
+                  tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
+                  sshn (:,:)     = sshb(:,:)
+                  un   (:,:,:)   = ub  (:,:,:)
+                  vn   (:,:,:)   = vb  (:,:,:)
+               ELSEIF( ln_wd .or. ln_rwd   ) THEN ! if not test case
+                  sshn(:,:) = -rn_ssh_ref
+                  sshb(:,:) = -rn_ssh_ref
+
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        IF( ht_0(ji,jj)-rn_ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
+
+                           sshb(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
+                           sshn(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
+                           ssha(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
+                        ENDIF
+                     ENDDO
+                  ENDDO
+               ENDIF !If wad elseif ln_wd or ln_rwd
+
+               ! Adjust vertical metrics for all wad
                DO jk = 1, jpk
-                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
-                    &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-                    &            + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
+                    e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) - rn_ht_0 + sshn(:,:)  ) &
+                      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+                      &            + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
                END DO
                e3t_b(:,:,:) = e3t_n(:,:,:)
-               !
-            ELSEIF( ln_wd ) THEN
-               !
-              DO jj = 1, jpj
-                DO ji = 1, jpi
-                  IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN
-                     ! potential bug
-                     ! Warning this assumes 2 layers only over wetting locations. needs investigating
-                     e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1
-                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1
-                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1
-                     sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)           !!gm I don't understand that !
-                     sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                     ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
-                  ENDIF
-                ENDDO
-              ENDDO
+
+               DO ji = 1, jpi
+                  DO jj = 1, jpj
+                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT(ssmask(ji,jj)) .EQ. 1) THEN
+                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
+                     ENDIF
+                  END DO 
+               END DO 
+ 
                !
             ELSE
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 8865)
@@ -18,5 +18,5 @@
    USE dom_oce         ! ocean space and time domain
    USE phycst ,   ONLY :   rsmall
-   USE wet_dry,   ONLY :   ln_wd, ht_wd
+   USE wet_dry,   ONLY :   ln_wd, ln_rwd
    !
    USE in_out_manager  ! I/O manager
@@ -198,8 +198,6 @@
       ENDIF
       !
-      IF( ln_wd ) THEN                                          ! wetting and drying domain
-         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
-         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
-      ENDIF
+      IF( ln_wd .OR. ln_rwd ) CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
+
       !                                     ! ============================
       CALL iom_close( inum )                !        close the files 
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 8865)
@@ -30,5 +30,5 @@
    USE usrdef_zgr     ! user defined vertical coordinate system
    USE depth_e3       ! depth <=> e3
-   USE wet_dry, ONLY: ln_wd, ht_wd
+   USE wet_dry, ONLY: ln_wd, ln_rwd, rn_ssh_ref
    !
    USE in_out_manager ! I/O manager
@@ -258,6 +258,6 @@
       k_bot(:,:) = INT( z2d(:,:) )
       !
-      ! bathymetry with orography (wetting and drying only)
-      IF( ln_wd )  CALL iom_get( inum, jpdom_data, 'ht_wd' , ht_wd  , lrowattr=ln_use_jattr )
+      ! reference depth for negative bathy (wetting and drying only)
+      IF( ln_wd .OR. ln_rwd )  CALL iom_get( inum,  'rn_wd_ref_depth' , rn_ssh_ref   )
       !
       CALL iom_close( inum )
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 8865)
@@ -455,10 +455,10 @@
            DO ji = 2, jpim1 
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji+1,jj) + ht_0(ji+1,jj) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -466,5 +466,5 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
              ELSE
@@ -473,10 +473,10 @@
       
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji,jj+1) + ht_0(ji,jj+1) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -484,5 +484,5 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
              ELSE
@@ -707,10 +707,10 @@
            DO ji = 2, jpim1 
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji+1,jj) + ht_0(ji+1,jj) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -718,5 +718,5 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
              ELSE
@@ -725,10 +725,10 @@
       
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji,jj+1) + ht_0(ji,jj+1) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -736,5 +736,5 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
              ELSE
@@ -1006,10 +1006,10 @@
            DO ji = 2, jpim1 
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji+1,jj) + ht_0(ji+1,jj) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -1017,6 +1017,8 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+              
+                zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
              ELSE
                zcpx(ji,jj) = 0._wp
@@ -1024,10 +1026,10 @@
       
              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji,jj+1) + ht_0(ji,jj+1) ) &
                   &                                                         > rn_wdmin1 + rn_wdmin2
              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
                   &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
 
              IF(ll_tmp1) THEN
@@ -1035,6 +1037,8 @@
              ELSE IF(ll_tmp2) THEN
                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+                zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
+
              ELSE
                zcpy(ji,jj) = 0._wp
@@ -1228,6 +1232,6 @@
                ENDIF
                IF( ln_wd ) THEN
-                  zdpdx1 = zdpdx1 * zcpx(ji,jj)
-                  zdpdx2 = zdpdx2 * zcpx(ji,jj)
+                  zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
+                  zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
                ENDIF
                ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
@@ -1287,6 +1291,6 @@
                ENDIF
                IF( ln_wd ) THEN
-                  zdpdy1 = zdpdy1 * zcpy(ji,jj)
-                  zdpdy2 = zdpdy2 * zcpy(ji,jj)
+                  zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
+                  zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
                ENDIF
 
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 8865)
@@ -28,4 +28,5 @@
    USE dom_oce        ! ocean space and time domain
    USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbcrnf         ! river runoffs
    USE phycst         ! physical constants
    USE dynadv         ! dynamics: vector invariant versus flux form
@@ -220,5 +221,18 @@
                IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting
                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) &
-                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+                                 &                      ) * tmask(:,:,1)
+                  IF( ln_rnf_depth ) THEN 
+                     DO jk = 1, jpkm1 ! Deal with Rivers separetely, as can be through depth too, not sure for ice shelf case yet
+                        DO jj = 1, jpj
+                           DO ji = 1, jpi
+                              IF( mikt(ji,jj) <= jk .and. jk <=  nk_rnf(ji,jj)  ) THEN
+                                 e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef *  (rnf_b(ji,jj) - rnf(ji,jj))*(e3t_n(ji,jj,jk)/h_rnf(ji,jj)  )*tmask(ji,jj,jk)
+                              ENDIF
+                           ENDDO
+                        ENDDO
+                     ENDDO
+                  ELSE
+                      e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef *  (rnf_b(ji,jj) - rnf(ji,jj))*tmask(ji,jj,1)
+                  ENDIF
                ELSE                     ! if ice shelf melting
                   DO jj = 1, jpj
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8865)
@@ -1,3 +1,6 @@
 MODULE dynspg_ts
+
+   !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out ! 
+
    !!======================================================================
    !!                   ***  MODULE  dynspg_ts  ***
@@ -150,4 +153,8 @@
       REAL(wp) ::   zhura, zhvra         	!   -      -
       REAL(wp) ::   za0, za1, za2, za3		!   -      -
+      REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_rwd = .True. 
+
+      INTEGER  :: iwdg, jwdg, kwdg   ! short-hand values for the indices of the output point
+
       !
       REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e
@@ -158,4 +165,6 @@
       REAL(wp), POINTER, DIMENSION(:,:) :: zhf
       REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy                 ! Wetting/Dying gravity filter coef.
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
+      REAL(wp), POINTER, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask
       !!----------------------------------------------------------------------
       !
@@ -170,4 +179,11 @@
       CALL wrk_alloc( jpi,jpj,   zhf )
       IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy )
+      IF( ln_rwd ) CALL wrk_alloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2)
+
+      IF ( ln_wd_diag ) THEN 
+         iwdg = jn_wd_i ; jwdg = jn_wd_j ; kwdg = jn_wd_k
+         WRITE(numout,*) 'kt, iwdg, jwdg, kwdg = ', kt, iwdg, jwdg, kwdg 
+      END IF 
+
       !
       zmdi=1.e+20                               !  missing data indicator for masking
@@ -178,4 +194,6 @@
       z1_2  = 0.5_wp     
       zraur = 1._wp / rau0
+      zwdramp = 1._wp / rn_wdmin1                 ! simplest ramp 
+!     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1)   ! more general ramp
       !  	                                       ! reciprocal of baroclinic time step 
       IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
@@ -403,10 +421,10 @@
               DO ji = 2, jpim1 
                 ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
-                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                     &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+                     &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji+1,jj) + ht_0(ji+1,jj) ) &
                      &                                                         > rn_wdmin1 + rn_wdmin2
                 ll_tmp2 = ( ABS( sshn(ji+1,jj)             -   sshn(ji  ,jj))  > 1.E-12 ).AND.( &
                      &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+                     &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
    
                 IF(ll_tmp1) THEN
@@ -414,6 +432,8 @@
                 ELSE IF(ll_tmp2) THEN
                   ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
                               &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+                  zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+
                 ELSE
                   zcpx(ji,jj) = 0._wp
@@ -421,10 +441,10 @@
          
                 ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
-                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                     &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+                     &    MAX(   sshn(ji,jj) + ht_0(ji,jj),   sshn(ji,jj+1) + ht_0(ji,jj+1) ) &
                      &                                                         > rn_wdmin1 + rn_wdmin2
                 ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1))  > 1.E-12 ).AND.( &
                      &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
-                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+                     &    MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
    
                 IF(ll_tmp1) THEN
@@ -432,6 +452,8 @@
                 ELSE IF(ll_tmp2) THEN
                   ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
                               &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+                  zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
+
                 ELSE
                   zcpy(ji,jj) = 0._wp
@@ -443,7 +465,8 @@
               DO ji = 2, jpim1
                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
-                        &                        * r1_e1u(ji,jj) * zcpx(ji,jj)
+                        &                        * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
-                        &                        * r1_e2v(ji,jj) * zcpy(ji,jj)
+                        &                        * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
+
               END DO
            END DO
@@ -491,6 +514,6 @@
       ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
       IF( ln_wd ) THEN
-        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:)
-        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:)
+        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) *  wdrampu(ji,jj)
+        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) *  wdrampv(ji,jj)
       ELSE
         zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:)
@@ -627,4 +650,13 @@
       vn_adv(:,:) = 0._wp
       !                                             ! ==================== !
+
+      IF (ln_rwd) THEN
+         zuwdmask(:,:) = 0._wp  ! set to zero for definiteness (not sure this is necessary) 
+         zvwdmask(:,:) = 0._wp  ! 
+         zuwdav2(:,:) =  0._wp 
+         zvwdav2(:,:) =  0._wp   
+      END IF 
+
+
       DO jn = 1, icycle                             !  sub-time-step loop  !
          !                                          ! ==================== !
@@ -654,5 +686,40 @@
             ! Extrapolate Sea Level at step jit+0.5:
             zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:)
-            !
+            
+            ! set wetting & drying mask at tracer points for this barotropic sub-step 
+            IF ( ln_rwd ) THEN 
+
+               IF ( ln_rwd_rmp ) THEN 
+                  DO jj = 1, jpj                                 
+                     DO ji = 1, jpi   ! vector opt.  
+                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
+!                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin2 ) THEN 
+                           ztwdmask(ji,jj) = 1._wp
+                        ELSE IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
+                           ztwdmask(ji,jj) = (tanh(50._wp*( ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )/rn_wdmin1)) ) 
+                        ELSE 
+                           ztwdmask(ji,jj) = 0._wp
+                        END IF
+                     END DO
+                  END DO
+               ELSE
+                  DO jj = 1, jpj                                 
+                     DO ji = 1, jpi   ! vector opt.  
+                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
+                           ztwdmask(ji,jj) = 1._wp
+                        ELSE 
+                           ztwdmask(ji,jj) = 0._wp
+                        END IF
+                     END DO
+                  END DO
+               END IF 
+
+               IF ( ln_wd_diag ) WRITE(numout,*) 'kt, jn = ', kt, jn 
+               IF ( ln_wd_diag ) WRITE(numout, *) 'zsshp2_e: (i,j), (i+1,j), (i,j+1) = ', zsshp2_e(iwdg,jwdg), zsshp2_e(iwdg+1,jwdg), zsshp2_e(iwdg,jwdg+1)
+               IF ( ln_wd_diag ) WRITE(numout, *) 'ht_0:     (i,j), (i+1,j), (i,j+1) = ', ht_0(iwdg,jwdg), ht_0(iwdg+1,jwdg), (iwdg,jwdg+1)
+               IF ( ln_wd_diag ) WRITE(numout, *) 'ztwdmask: (i,j), (i+1,j), (i,j+1) = ', ztwdmask(iwdg,jwdg), ztwdmask(iwdg+1,jwdg), ztwdmask(iwdg,jwdg+1) 
+            END IF 
+           
+
             DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
                DO ji = 2, fs_jpim1   ! Vector opt.
@@ -707,10 +774,66 @@
 #endif
          IF( ln_wd ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt)
-         !
+
+         IF ( ln_rwd ) THEN 
+
+            IF ( ln_wd_diag ) THEN 
+               WRITE(numout, *) 'zwx: (i,j), (i+1,j) = ', zwx(iwdg,jwdg), zwx(iwdg+1,jwdg)
+               WRITE(numout, *) 'zwy: (i,j), (i,j+1) = ', zwy(iwdg,jwdg), zwx(iwdg,jwdg+1)
+            END IF 
+
+! un_e and vn_e are set to zero at faces where the direction of the flow is from dry cells 
+
+            DO jj = 1, jpjm1                                 
+               DO ji = 1, jpim1   
+                  IF ( zwx(ji,jj) > 0.0 ) THEN 
+                     zuwdmask(ji, jj) = ztwdmask(ji  ,jj) 
+                  ELSE 
+                     zuwdmask(ji, jj) = ztwdmask(ji+1,jj)  
+                  END IF 
+                  zwx(ji, jj) = zuwdmask(ji,jj)*zwx(ji, jj)
+                  un_e(ji,jj) = zuwdmask(ji,jj)*un_e(ji,jj)
+
+                  IF ( zwy(ji,jj) > 0.0 ) THEN
+                     zvwdmask(ji, jj) = ztwdmask(ji, jj  )
+                  ELSE 
+                     zvwdmask(ji, jj) = ztwdmask(ji, jj+1)  
+                  END IF 
+                  zwy(ji, jj) = zvwdmask(ji,jj)*zwy(ji,jj) 
+                  vn_e(ji,jj) = zvwdmask(ji,jj)*vn_e(ji,jj)
+               END DO
+            END DO
+
+            IF ( ln_wd_diag ) THEN 
+               WRITE(numout, *) 'zuwdmask: (i,j)     = ', zuwdmask(iwdg,jwdg)
+               WRITE(numout, *) 'zwx: (i,j)          = ', zwx(iwdg,jwdg)
+               WRITE(numout, *) 'e2u: (i,j)          = ', e2u(iwdg,jwdg)
+               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
+               WRITE(numout, *) 'un_e: (i,j)         = ', un_e(iwdg,jwdg)
+               WRITE(numout, *) 'zhup2_e: (i,j)      = ', zhup2_e(iwdg,jwdg)
+               WRITE(numout, *) 'zvwdmask: (i,j)     = ', zvwdmask(iwdg,jwdg)
+               WRITE(numout, *) 'zwy: (i,j)          = ', zwy(iwdg,jwdg) 
+            END IF 
+
+         END IF    
+         
          ! Sum over sub-time-steps to compute advective velocities
          za2 = wgtbtp2(jn)
          un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
          vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
-         !
+         
+         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_rwd_bc = True) 
+         IF ( ln_rwd_bc ) THEN
+            zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:)
+            zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:)
+
+            IF ( ln_wd_diag ) THEN 
+               WRITE(numout, *) 'za2, r1_e2u(i,j)     = ', za2, r1_e2u(iwdg,jwdg) 
+               WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
+               WRITE(numout, *) 'zuwdav2: (i,j)       = ', zuwdav2(iwdg,jwdg)
+               WRITE(numout, *) 'zvwdav2: (i,j)       = ', zvwdav2(iwdg,jwdg)
+            END IF 
+
+         END IF 
+
          ! Set next sea level:
          DO jj = 2, jpjm1                                 
@@ -770,10 +893,10 @@
               DO ji = 2, jpim1 
                 ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                     &    MAX(   -ht_0(ji,jj)               ,   -ht_0(ji+1,jj) ) .AND.            &
+                     &    MAX( zsshp2_e(ji,jj) + ht_0(ji,jj), zsshp2_e(ji+1,jj) + ht_0(ji+1,jj) ) &
                      &                                                             > rn_wdmin1 + rn_wdmin2
                 ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji+1,jj))  > 1.E-12 ).AND.( &
                      &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+                     &    MAX(   -ht_0(ji,jj)               ,   -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
    
                 IF(ll_tmp1) THEN
@@ -781,5 +904,5 @@
                 ELSE IF(ll_tmp2) THEN
                   ! no worries about  zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj) = 0, it won't happen ! here
-                  zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) +    ht_wd(ji+1,jj) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
+                  zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) +    ht_0(ji+1,jj) - zsshp2_e(ji,jj) - ht_0(ji,jj)) &
                               &    / (zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj)) )
                 ELSE
@@ -788,10 +911,10 @@
          
                 ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                     &    MAX(   -ht_0(ji,jj)               ,   -ht_0(ji,jj+1) ) .AND.            &
+                     &    MAX( zsshp2_e(ji,jj) + ht_0(ji,jj), zsshp2_e(ji,jj+1) + ht_0(ji,jj+1) ) &
                      &                                                             > rn_wdmin1 + rn_wdmin2
                 ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji,jj+1))  > 1.E-12 ).AND.( &
                      &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+                     &    MAX(   -ht_0(ji,jj)               ,   -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
    
                 IF(ll_tmp1) THEN
@@ -799,5 +922,5 @@
                 ELSE IF(ll_tmp2) THEN
                   ! no worries about  zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  ) = 0, it won't happen ! here
-                  zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) +    ht_wd(ji,jj+1) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
+                  zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) +    ht_0(ji,jj+1) - zsshp2_e(ji,jj) - ht_0(ji,jj)) &
                               &    / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  )) )
                 ELSE
@@ -886,6 +1009,7 @@
          !
          ! Add bottom stresses:
-         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
-         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+!jth do implicitly instead
+!         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
+!         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
          !
          ! Add top stresses:
@@ -933,4 +1057,9 @@
                             &                                 + zv_frc(ji,jj) ) &
                             &   ) * ssvmask(ji,jj)
+ 
+!jth implicit bottom friction:
+               ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * bfrua(ji,jj) * hur_e(ji,jj))
+               va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * bfrva(ji,jj) * hvr_e(ji,jj))
+
                END DO
             END DO
@@ -941,6 +1070,6 @@
 
                   IF( ln_wd ) THEN
-                    zhura = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1)
-                    zhvra = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1)
+                    zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
+                    zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
                   ELSE
                     zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
@@ -964,9 +1093,25 @@
             END DO
          ENDIF
-         !
+
+! if ln_rwd: ua_e and va_e should not be masked ; they are used to determine the direction of flow into all cells
+
+!         IF ( ln_rwd) THEN 
+!            IF ( ln_wd_diag ) THEN 
+!               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
+!               WRITE(numout, *) 'va_e: (i,j)         = ', va_e(iwdg,jwdg)
+!            END IF 
+!            ua_e(:,:) = ua_e(:,:) * zuwdmask(:,:) 
+!            va_e(:,:) = va_e(:,:) * zvwdmask(:,:) 
+!            IF ( ln_wd_diag ) THEN 
+!               WRITE(numout, *) 'ua_e: (i,j)         = ', ua_e(iwdg,jwdg)
+!               WRITE(numout, *) 'va_e: (i,j)         = ', va_e(iwdg,jwdg)
+!            END IF 
+!         END IF 
+
+         
          IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only)
             IF( ln_wd ) THEN
-              hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1)
-              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1)
+              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
+              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
             ELSE
               hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
@@ -1006,9 +1151,15 @@
             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
          ELSE                                              ! Sum transports
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+            IF (.NOT.ln_rwd) THEN  
+               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
+               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+            ELSE 
+               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
+               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
+            END IF 
          ENDIF
          !                       			   ! Sum sea level
          ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
+
          !                                                 ! ==================== !
       END DO                                               !        end loop      !
@@ -1033,4 +1184,12 @@
          vb2_b(:,:) = zwy(:,:)
       ENDIF
+
+      IF ( ln_wd_diag ) THEN 
+         WRITE(numout, *) 'ub2_b: (i,j)        = ', ub2_b(iwdg,jwdg)
+         WRITE(numout, *) 'r1_hu_n: (i,j)      = ', r1_hu_n(iwdg,jwdg)
+         WRITE(numout, *) 'zwx: (i,j)          = ', zwx(iwdg,jwdg)
+         WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
+      END IF 
+
       !
       ! Update barotropic trend:
@@ -1062,12 +1221,46 @@
          va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
       ENDIF
-      !
+
+      IF ( ln_wd_diag ) THEN 
+         WRITE(numout, *) 'ua_b: (i,j) A        = ', ua_b(iwdg,jwdg)
+         WRITE(numout, *) 'va_b: (i,j) B        = ', va_b(iwdg,jwdg)
+      END IF 
+
+! temporary debugging code 
+      IF ( ln_wd_diag ) THEN 
+         WRITE(numout, *) 'ua: (i,j,k)  B       = ', ua(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'ua_b: (i,j)  B       = ', ua_b(iwdg,jwdg)
+         WRITE(numout, *) 'un: (i,j,k)          = ', un(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'un_b: (i,j)          = ', un_b(iwdg,jwdg)
+         WRITE(numout, *) 'un_adv: (i,j)        = ', un_adv(iwdg,jwdg)
+         WRITE(numout, *) 'va: (i,j,k)          = ', va(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'va_b: (i,j,k)        = ', va_b(iwdg,jwdg)
+         WRITE(numout, *) 'vn: (i,j,k)          = ', vn(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'vn_b: (i,j)          = ', vn_b(iwdg,jwdg)
+         WRITE(numout, *) 'vn_adv: (i,j)        = ', vn_adv(iwdg,jwdg)
+      END IF 
+
+      ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)  
       DO jk = 1, jpkm1
-         ! Correct velocities:
          un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk)
          vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
-         !
       END DO
-      !
+
+      IF ( ln_rwd .and. ln_rwd_bc) THEN 
+         DO jk = 1, jpkm1
+            un(:,:,jk) = ( un_adv(:,:) + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)) ) * umask(:,:,jk) 
+            vn(:,:,jk) = ( vn_adv(:,:) + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)) ) * vmask(:,:,jk)  
+         END DO
+      END IF 
+
+      IF ( ln_wd_diag ) THEN 
+         WRITE(numout, *) 'ua: (i,j,k)          = ', ua(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'ua_b: (i,j,k)        = ', ua_b(iwdg,jwdg)
+         WRITE(numout, *) 'un: (i,j,k)          = ', un(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'va: (i,j,k)          = ', va(iwdg,jwdg,kwdg)
+         WRITE(numout, *) 'va_b: (i,j,k)        = ', va_b(iwdg,jwdg)
+         WRITE(numout, *) 'vn: (i,j,k)          = ', vn(iwdg,jwdg,kwdg)
+      END IF 
+      
       CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
       CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current
@@ -1098,4 +1291,5 @@
       CALL wrk_dealloc( jpi,jpj,   zhf )
       IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )
+      IF( ln_rwd ) CALL wrk_dealloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 )
       !
       IF ( ln_diatmb ) THEN
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 8865)
@@ -1,3 +1,6 @@
 MODULE wet_dry
+
+   !! includes updates to namelist namwad for diagnostic outputs of ROMS wetting and drying
+
    !!==============================================================================
    !!                       ***  MODULE  wet_dry  ***
@@ -32,13 +35,23 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter 
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd          !: wetting and drying t-pt depths
                                                                      !  (can include negative depths)
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdramp, wdrampu, wdrampv ! for hpg limiting
 
    LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off)
+   REAL(wp), PUBLIC  ::   rn_wdmin0   !: depth at which wetting/drying starts
+   LOGICAL,  PUBLIC  ::   ln_rwd      !: ROMS Wetting/drying activation switch (T:on,F:off)
    REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells
-   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerrance of minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerance of minimum water depth on dried cells
    REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying 
                                            !: will be considered
    INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
+   LOGICAL,  PUBLIC  ::   ln_rwd_bc   !: ROMS scheme: True implies 3D velocities are set to the barotropic values at points 
+                                      !: where the flow is from wet points on less than half the barotropic sub-steps  
+   LOGICAL,  PUBLIC  ::   ln_rwd_rmp  !: use a ramp for the rwd flux limiter between 2 rn_wdmin1 and rn_wdmin1 (rather than a cut-off at rn_wdmin1)      
+   REAL(wp), PUBLIC  ::   rn_ssh_ref  !: height of z=0 with respect to the geoid; 
+   REAL(wp), PUBLIC  ::   rn_ht_0     !: the height at which ht_0 = 0   
+
+   LOGICAL,  PUBLIC  ::   ln_wd_diag  ! True implies wad diagnostic at chosen point are printed out
+   INTEGER , PUBLIC  ::   jn_wd_i, jn_wd_j, jn_wd_k   ! indices at which diagnostic outputs are generated 
 
    PUBLIC   wad_init                  ! initialisation routine called by step.F90
@@ -58,5 +71,7 @@
       !! ** input   : - namwad namelist
       !!----------------------------------------------------------------------
-      NAMELIST/namwad/ ln_wd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit
+      NAMELIST/namwad/ ln_wd, ln_rwd, rn_wdmin0, ln_rwd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit, ln_wd_diag, ln_rwd_bc, &
+                     &  rn_ht_0, jn_wd_i, jn_wd_j, jn_wd_k,ln_rwd_rmp
+
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       INTEGER  ::   ierr                ! Local integer status array allocation 
@@ -78,13 +93,23 @@
          WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namwad'
-         WRITE(numout,*) '      Logical activation                 ln_wd      = ', ln_wd
+         WRITE(numout,*) '      Logical for NOC  wd scheme         ln_wd      = ', ln_wd
+         WRITE(numout,*) '      Logical for ROMS wd scheme         ln_rwd     = ', ln_rwd
+         WRITE(numout,*) '      Depth at which wet/drying starts rn_wdmin0    = ', rn_wdmin0
          WRITE(numout,*) '      Minimum wet depth on dried cells rn_wdmin1    = ', rn_wdmin1
          WRITE(numout,*) '      Tolerance of min wet depth     rn_wdmin2      = ', rn_wdmin2
          WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld
          WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit
+         WRITE(numout,*) '      Logical for WAD diagnostics      ln_wd_diag   = ', ln_wd_diag
+         WRITE(numout,*) '      T => baroclinic u,v = 0 at dry pts: ln_rwd_bc = ', ln_rwd_bc     
+         WRITE(numout,*) '      use a ramp for rwd limiter:      ln_rwd_rmp   = ', ln_rwd_rmp
+         WRITE(numout,*) '      the height (z) at which ht_0 = 0:rn_ht_0      = ', rn_ht_0  
+         WRITE(numout,*) '      i-index for diagnostic point     jn_wd_i      = ', jn_wd_i
+         WRITE(numout,*) '      j-index for diagnostic point     jn_wd_j      = ', jn_wd_j
+         WRITE(numout,*) '      k-index for diagnostic point     jn_wd_k      = ', jn_wd_k
       ENDIF
       !
-      IF(ln_wd) THEN
-         ALLOCATE( wdmask(jpi,jpj), ht_wd(jpi,jpj),  STAT=ierr )
+      IF(ln_wd .OR. ln_rwd) THEN
+         ALLOCATE( wdmask(jpi,jpj),   STAT=ierr )
+         ALLOCATE( wdramp(jpi,jpj), wdrampu(jpi,jpj), wdrampv(jpi,jpj), STAT=ierr ) 
          IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
       ENDIF
@@ -161,5 +186,5 @@
 
              IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE   ! we don't care about land cells
-             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+             IF( ht_0(ji,jj)-rn_ssh_ref > zdepwd )      CYCLE   ! and cells which are unlikely to dry
 
               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
@@ -168,7 +193,7 @@
                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
 
-              zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1
+              zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1
               IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary
-                sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
@@ -180,4 +205,21 @@
         END DO
 
+
+! slwa
+! HPG limiter from jholt
+      wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
+!      write(6,*)'wdramp ',wdramp(10,10),wdramp(10,11)
+!jth assume don't need a lbc_lnk here
+       DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+           wdrampu(ji,jj) = min(wdramp(ji,jj),wdramp(ji+1,jj))
+           wdrampv(ji,jj) = min(wdramp(ji,jj),wdramp(ji,jj+1))
+         ENDDO
+       ENDDO
+        !wdrampu(:,:)=1.0_wp
+        !wdrampv(:,:)=1.0_wp
+! end HPG limiter
+
+
       
         !! start limiter iterations 
@@ -193,5 +235,5 @@
         
                  IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 
-                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
+                 IF( ht_0(ji,jj) > zdepwd )      CYCLE
         
                  ztmp = e1e2t(ji,jj)
@@ -203,5 +245,5 @@
           
                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-                 zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
+                 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
           
                  IF( zdep1 > zdep2 ) THEN
@@ -317,5 +359,5 @@
 
              IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
-             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+             IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
 
               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
@@ -324,7 +366,7 @@
                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
 
-              zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
+              zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
               IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary
-                sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
@@ -348,5 +390,5 @@
         
                  IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE 
-                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
+                 IF( ht_0(ji,jj) > zdepwd )      CYCLE
         
                  ztmp = e1e2t(ji,jj)
@@ -358,5 +400,5 @@
           
                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-                 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
+                 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
           
                  IF(zdep1 > zdep2) THEN
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 8865)
@@ -39,5 +39,5 @@
    !                                                !!* namsbc_rnf namelist *
    CHARACTER(len=100)         ::   cn_dir            !: Root directory for location of rnf files
-   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
    LOGICAL                    ::      ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
    REAL(wp)                   ::      rn_rnf_max        !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T)
@@ -133,5 +133,5 @@
             END WHERE
          ELSE                                                        ! use SST as runoffs temperature
-            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+         rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0 !CEOD River is fresh water so must at least be 0 unless we consider ice
          ENDIF
          !                                                           ! use runoffs salinity data
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 8865)
@@ -317,8 +317,18 @@
                   IF( jk == mikt(ji,jj) ) THEN           ! first level 
                      ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
-                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
                             &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
                      ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
+                  ! Rivers can be not just at the surface must go down to nk_rnd(ji,jj)
+                  IF( ln_rnf_depth ) THEN
+                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN
+                      ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   )  )*(e3t_n(ji,jj,jk)/h_rnf(ji,jj) ) ! as we have sigma can do that here change later
+                     ENDIF
+                  ELSE
+                      IF( jk == mikt(ji,jj) ) THEN           ! first level 
+                         ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
+                      ENDIF
+                  ENDIF
+
                   !
                   ! solar penetration (temperature only)
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 8865)
@@ -34,4 +34,5 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
+   USE wet_dry
 
    IMPLICIT NONE
@@ -122,5 +123,16 @@
       DO jj = 2, jpj
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+            IF ( ln_rwd_rmp ) THEN    ! If near WAD point limite the flux for now
+               IF ( sshn(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN
+                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+               ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
+                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) * (tanh(5._wp*( ( sshn(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )/rn_wdmin1)) )
+               ELSE
+                  sbc_tsc(ji,jj,jp_tem) = 0._wp
+               ENDIF
+            ELSE 
+               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+            ENDIF
+
             sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
          END DO
Index: /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8864)
+++ /branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8865)
@@ -22,4 +22,5 @@
    USE lib_mpp         ! distributed memory computing
    USE lib_fortran     ! Fortran routines library 
+   USE wet_dry,  ONLY: ln_wd, ln_rwd, rn_ssh_ref    ! reference depth for negative bathy
 
    IMPLICIT NONE
@@ -150,5 +151,9 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
+            IF( (ln_wd .OR. ln_rwd)) THEN
+               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)+rn_ssh_ref) )
+            ELSE
+               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
+            ENDIF
          END DO
       END DO
