Changeset 14086 for NEMO/trunk/src/NST

Timestamp:

2020-12-04T12:37:14+01:00 (3 years ago)

Author:

cetlod

Message:

Adding AGRIF branches into the trunk

Location:

NEMO/trunk/src/NST

Files:

• agrif_ice_interp.F90 (modified) (3 diffs)
• agrif_oce.F90 (modified) (8 diffs)
• agrif_oce_interp.F90 (modified) (61 diffs)
• agrif_oce_sponge.F90 (modified) (15 diffs)
• agrif_oce_update.F90 (modified) (24 diffs)
• agrif_top_interp.F90 (modified) (3 diffs)
• agrif_top_sponge.F90 (modified) (4 diffs)
• agrif_top_update.F90 (modified) (3 diffs)
• agrif_user.F90 (modified) (36 diffs)
• vremap.F90 (modified) (3 diffs)

NEMO/trunk/src/NST/agrif_ice_interp.F90

@@ -25 +25 @@
    USE agrif_oce
    USE phycst , ONLY: rt0
+   USE icevar
+   USE sbc_ice, ONLY : tn_ice
    
    IMPLICIT NONE
@@ -30 +32 @@
 
    PUBLIC   agrif_interp_ice   ! called by agrif_user.F90
-   PUBLIC   interp_tra_ice, interp_u_ice, interp_v_ice  ! called by iceistate.F90
+   PUBLIC   agrif_istate_ice   ! called by icerst.F90
 
    !!----------------------------------------------------------------------
@@ -39 +41 @@
 
 CONTAINS
+
+   SUBROUTINE agrif_istate_ice
+      !!-----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_istate_ice  ***
+      !!
+      !!  ** Method  : Set initial ice fields from parent grid
+      !!
+      !!-----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) 'Agrif_istate_ice : interp child ice initial state from parent'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) ' '
+
+      ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i:
+      Agrif_SpecialValue    = -9999.
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice)
+      !
+      ! Set u_ice, v_ice:
+      use_sign_north = .TRUE.
+      sign_north = -1.
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice)
+      CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice)
+      Agrif_SpecialValue = 0._wp
+      use_sign_north = .FALSE.
+      Agrif_UseSpecialValue = .FALSE.
+      ! lbc ????
+      ! JC: do we really need the 3 lines below ?
+      CALL ice_var_glo2eqv
+      CALL ice_var_zapsmall
+      CALL ice_var_agg(2)
+
+      ! Melt ponds
+      WHERE( a_i > epsi10 )
+         a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:)
+      ELSEWHERE
+         a_ip_frac(:,:,:) = 0._wp
+      END WHERE
+      WHERE( a_ip > 0._wp )       ! ???????    
+         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)
+      ELSEWHERE
+         h_ip(:,:,:) = 0._wp
+      END WHERE   
+
+      tn_ice(:,:,:) = t_su(:,:,:)
+      t1_ice(:,:,:) = t_i (:,:,1,:) 
+
+   END SUBROUTINE agrif_istate_ice
 
    SUBROUTINE agrif_interp_ice( cd_type, kiter, kitermax )

NEMO/trunk/src/NST/agrif_oce.F90

@@ -23 +23 @@
    LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in
                                                    !: bdys dynamical fields interpolation
-   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
-   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_vert_remap = .FALSE.   !: use vertical remapping
+   REAL(wp), PUBLIC ::   rn_sponge_tra = 0.002     !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn = 0.002     !: sponge coeff. for dynamics
    REAL(wp), PUBLIC ::   rn_trelax_tra = 0.01      !: time relaxation parameter for tracers
    REAL(wp), PUBLIC ::   rn_trelax_dyn = 0.01      !: time relaxation parameter for momentum
@@ -30 +31 @@
    !
    INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
+   INTEGER , PUBLIC, PARAMETER ::   nn_shift_bar = 0   !: nb of coarse grid points by which we shift 2d interface
 
    LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
@@ -35 +37 @@
    LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step
    LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info
-
+   LOGICAL , PUBLIC :: lk_tint2d_notinterp = .FALSE. !: if true, no time interp
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
 # if defined key_top
@@ -46 +48 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspu, fspv !: sponge arrays
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspt, fspf !:   "      "
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspu_2d,fspv_2d  !: sponge arrays (2d mode)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspt_2d, fspf_2d !:   "       "     "   "
 
    ! Barotropic arrays used to store open boundary data during time-splitting loop:
@@ -51 +55 @@
    INTEGER , PUBLIC,              SAVE                 ::  Kbb_a, Kmm_a, Krhs_a   !: AGRIF module-specific copies of time-level indices
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent
-   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ht0_parent, hu0_parent, hv0_parent
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t0_parent, e3u0_parent, e3v0_parent
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: mbkt_parent, mbku_parent, mbkv_parent
 
-   INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
+
+   INTEGER, PUBLIC :: ts_interp_id, ts_update_id                              ! AGRIF profile for tracers interpolation and update
    INTEGER, PUBLIC :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations
    INTEGER, PUBLIC :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates
-   INTEGER, PUBLIC :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers
+   INTEGER, PUBLIC :: ts_sponge_id, un_sponge_id, vn_sponge_id                ! AGRIF profiles for sponge layers (3d)
+   INTEGER, PUBLIC :: unb_sponge_id, vnb_sponge_id                            ! AGRIF profiles for sponge layers (2d)
    INTEGER, PUBLIC :: tsini_id, uini_id, vini_id, sshini_id                   ! AGRIF profile for initialization
 # if defined key_top
    INTEGER, PUBLIC :: trn_id, trn_sponge_id
 # endif  
-   INTEGER, PUBLIC :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id
-   INTEGER, PUBLIC :: ub2b_update_id, vb2b_update_id
-   INTEGER, PUBLIC :: e3t_id, e1u_id, e2v_id, sshn_id
+   INTEGER, PUBLIC :: unb_interp_id, vnb_interp_id, ub2b_interp_id, vb2b_interp_id
+   INTEGER, PUBLIC :: ub2b_update_id, vb2b_update_id, unb_update_id, vnb_update_id
+   INTEGER, PUBLIC :: ub2b_cor_id, vb2b_cor_id
+   INTEGER, PUBLIC :: e3t_id, sshn_id
    INTEGER, PUBLIC :: scales_t_id
    INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators
-   INTEGER, PUBLIC :: mbkt_id, ht0_id
+   INTEGER, PUBLIC :: mbkt_id, ht0_id, e3t0_interp_id
    INTEGER, PUBLIC :: glamt_id, gphit_id
+   INTEGER, PUBLIC :: batupd_id
    INTEGER, PUBLIC :: kindic_agr
 
@@ -74 +83 @@
 !$AGRIF_DO_NOT_TREAT
    LOGICAL, PUBLIC :: use_sign_north
-   REAL, PUBLIC :: sign_north
+   REAL, PUBLIC    :: sign_north
    LOGICAL, PUBLIC :: l_ini_child = .FALSE.
-# if defined key_vertical
-   LOGICAL, PUBLIC :: l_vremap    = .TRUE.
-# else
    LOGICAL, PUBLIC :: l_vremap    = .FALSE.
-# endif
 !$AGRIF_END_DO_NOT_TREAT
    
@@ -100 +105 @@
       ALLOCATE( fspu(jpi,jpj), fspv(jpi,jpj),          &
          &      fspt(jpi,jpj), fspf(jpi,jpj),               &
+         &      fspu_2d(jpi,jpj), fspv_2d(jpi,jpj),         &
+         &      fspt_2d(jpi,jpj), fspf_2d(jpi,jpj),         &
          &      tabspongedone_tsn(jpi,jpj),                 &
          &      utint_stage(jpi,jpj), vtint_stage(jpi,jpj), &
@@ -116 +123 @@
       !
    END FUNCTION agrif_oce_alloc
-
 #endif
    !!======================================================================

NEMO/trunk/src/NST/agrif_oce_interp.F90

@@ -45 +45 @@
    PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b
    PUBLIC   interpe3t, interpglamt, interpgphit
-   PUBLIC   interpht0, interpmbkt
-   PUBLIC   agrif_initts, agrif_initssh
+   PUBLIC   interpht0, interpmbkt, interpe3t0_vremap
+   PUBLIC   agrif_istate_oce, agrif_istate_ssh   ! called by icestate.F90 and domvvl.F90
+   PUBLIC   agrif_check_bat
 
    INTEGER ::   bdy_tinterp = 0
@@ -58 +59 @@
 CONTAINS
 
-   SUBROUTINE Agrif_tra
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_tra  ***
-      !!----------------------------------------------------------------------
-      !
-      IF( Agrif_Root() )   RETURN
-      !
+   SUBROUTINE Agrif_istate_oce( Kbb, Kmm, Kaa )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_istate_oce ***
+      !!
+      !!                 set initial t, s, u, v, ssh from parent
+      !!----------------------------------------------------------------------
+      !
+      IMPLICIT NONE
+      !
+      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa
+      INTEGER :: jn
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) 'Agrif_istate_oce : interp child initial state from parent'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) ' '
+
+      IF ( ln_rstart ) & 
+         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode')
+
+      IF ( .NOT.Agrif_Parent(l_1st_euler) ) & 
+         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent')
+
+      l_ini_child           = .TRUE.
+      Agrif_SpecialValue    = 0.0_wp
+      Agrif_UseSpecialValue = .TRUE.
+
+      ts(:,:,:,:,:) = 0.0_wp
+      uu(:,:,:,:)   = 0.0_wp
+      vv(:,:,:,:)   = 0.0_wp 
+      ssh(:,:,:)    = 0._wp
+       
+      Krhs_a = Kbb   ;   Kmm_a = Kbb
+
+      CALL Agrif_Init_Variable(tsini_id, procname=interptsn)
+      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn)
+
+      Agrif_UseSpecialValue = ln_spc_dyn
+      use_sign_north = .TRUE.
+      sign_north = -1._wp
+      CALL Agrif_Init_Variable(uini_id , procname=interpun )
+      CALL Agrif_Init_Variable(vini_id , procname=interpvn )
+      use_sign_north = .FALSE.
+
+      Agrif_UseSpecialValue = .FALSE.
+      l_ini_child           = .FALSE.
+
+      Krhs_a = Kaa   ;   Kmm_a = Kmm
+
+      ssh(:,:,Kbb) = ssh(:,:,Kbb) * tmask(:,:,1)
+
+      DO jn = 1, jpts
+         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb) * tmask(:,:,:)
+      END DO
+      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)     
+      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 
+
+      CALL lbc_lnk_multi( 'agrif_istate_oce', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp )
+      CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T',  1.0_wp )
+      CALL lbc_lnk( 'agrif_istate_oce', ssh(:,:,Kbb), 'T', 1.0_wp )
+
+   END SUBROUTINE Agrif_istate_oce
+
+
+   SUBROUTINE Agrif_istate_ssh( Kbb, Kmm )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_istate_ssh ***
+      !!
+      !!                    set initial ssh from parent
+      !!----------------------------------------------------------------------
+      !
+      IMPLICIT NONE
+      !
+      INTEGER, INTENT(in)  :: Kbb, Kmm 
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) 'Agrif_istate_ssh : interp child ssh from parent'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) ' '
+
+      IF ( ln_rstart ) & 
+         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode')
+
+      IF ( .NOT.Agrif_Parent(l_1st_euler) ) & 
+         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent')
+
+      Kmm_a = Kmm
+      ssh(:,:,Kmm) = 0._wp
+
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
-      !
-      CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
+      l_ini_child           = .TRUE.
+      !
+      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn)
       !
       Agrif_UseSpecialValue = .FALSE.
+      l_ini_child           = .FALSE.
+      CALL lbc_lnk( 'dom_vvl_rst', ssh(:,:,Kmm), 'T', 1._wp )
+
+   END SUBROUTINE Agrif_istate_ssh
+
+
+   SUBROUTINE Agrif_tra
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_tra  ***
+      !!----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      l_vremap           = ln_vert_remap
+      !
+      CALL Agrif_Bc_variable( ts_interp_id, procname=interptsn )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
       !
    END SUBROUTINE Agrif_tra
@@ -90 +195 @@
       Agrif_SpecialValue    = 0.0_wp
       Agrif_UseSpecialValue = ln_spc_dyn
+      l_vremap              = ln_vert_remap
       !
       use_sign_north = .TRUE.
@@ -95 +201 @@
       CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
       CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
+
+      IF( .NOT.ln_dynspg_ts ) THEN ! Get transports
+         ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp 
+         CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
+      ENDIF
+
       use_sign_north = .FALSE.
       !
       Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
+      !
+      ! Ensure below that vertically integrated transports match
+      ! either transports out of time splitting procedure (ln_dynspg_ts=.TRUE.)
+      ! or parent grid transports (ln_dynspg_ts=.FALSE.)
       !
       ! --- West --- !
       IF( lk_west ) THEN
          ibdy1 = nn_hls + 2                  ! halo + land + 1
-         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells
+         ibdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()   ! halo + land + nbghostcells
          !
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
             DO ji = mi0(ibdy1), mi1(ibdy2)
-               uu_b(ji,:,Krhs_a) = 0._wp
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
-                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
-                  END DO
-               END DO
                DO jj = 1, jpj
-                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a)
+                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
+                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
                END DO
             END DO
@@ -119 +232 @@
          !
          DO ji = mi0(ibdy1), mi1(ibdy2)
-            zub(ji,:) = 0._wp    ! Correct transport
+            zub(ji,:) = 0._wp  
             DO jk = 1, jpkm1
                DO jj = 1, jpj
@@ -135 +248 @@
          END DO
          !   
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            DO ji = mi0(ibdy1), mi1(ibdy2)
-               zvb(ji,:) = 0._wp
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
-                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
-                  END DO
-               END DO
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            zvb(ji,:) = 0._wp
+            DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
-               END DO
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
-                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+            END DO
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
          !
       ENDIF
@@ -158 +269 @@
       ! --- East --- !
       IF( lk_east) THEN
-         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()    
+         ibdy2 = jpiglo - ( nn_hls + 2 )                 
+         !
+         IF( .NOT.ln_dynspg_ts ) THEN 
             DO ji = mi0(ibdy1), mi1(ibdy2)
                uu_b(ji,:,Krhs_a) = 0._wp
@@ -170 +281 @@
                END DO
                DO jj = 1, jpj
-                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a)
+                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
                END DO
             END DO
@@ -176 +287 @@
          !
          DO ji = mi0(ibdy1), mi1(ibdy2)
-            zub(ji,:) = 0._wp    ! Correct transport
+            zub(ji,:) = 0._wp   
             DO jk = 1, jpkm1
                DO jj = 1, jpj
@@ -192 +303 @@
          END DO
          !
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1
-            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1
+         ibdy1 = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() 
+         ibdy2 = jpiglo - ( nn_hls + 1 )              !
+         IF( .NOT.ln_dynspg_ts ) THEN 
             DO ji = mi0(ibdy1), mi1(ibdy2)
-               zvb(ji,:) = 0._wp
+               vv_b(ji,:,Krhs_a) = 0._wp
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
+                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+               DO jj = 1, jpj
+                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
+               END DO
+            END DO
+         ENDIF
+
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            zvb(ji,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
                      zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
-                  END DO
-               END DO
+               END DO
+            END DO
+            DO jj = 1, jpj
+               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+            END DO
+            DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
-               END DO
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
                      vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+               END DO
+            END DO
+         END DO
          !
       ENDIF
@@ -217 +340 @@
       ! --- South --- !
       IF( lk_south ) THEN
-         jbdy1 = nn_hls + 2                  ! halo + land + 1
-         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         jbdy1 = nn_hls + 2                 
+         jbdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()   
+         !
+         IF( .NOT.ln_dynspg_ts ) THEN
             DO jj = mj0(jbdy1), mj1(jbdy2)
                vv_b(:,jj,Krhs_a) = 0._wp
@@ -229 +352 @@
                END DO
                DO ji=1,jpi
-                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)     
+                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
+                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a)
                END DO
             END DO
@@ -235 +359 @@
          !
          DO jj = mj0(jbdy1), mj1(jbdy2)
-            zvb(:,jj) = 0._wp    ! Correct transport
+            zvb(:,jj) = 0._wp
             DO jk=1,jpkm1
                DO ji=1,jpi
@@ -251 +375 @@
          END DO
          !
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            DO jj = mj0(jbdy1), mj1(jbdy2)
-               zub(:,jj) = 0._wp
-               DO jk = 1, jpkm1
-                  DO ji = 1, jpi
-                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
-                  END DO
-               END DO
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            zub(:,jj) = 0._wp
+            DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
-               END DO
-               DO jk = 1, jpkm1
-                  DO ji = 1, jpi
-                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+            END DO
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
          !
       ENDIF
@@ -274 +396 @@
       ! --- North --- !
       IF( lk_north ) THEN
-         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy() 
+         jbdy2 = jpjglo - ( nn_hls + 2 )
+         !
+         IF( .NOT.ln_dynspg_ts ) THEN
             DO jj = mj0(jbdy1), mj1(jbdy2)
                vv_b(:,jj,Krhs_a) = 0._wp
@@ -286 +408 @@
                END DO
                DO ji=1,jpi
-                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)
+                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
                END DO
             END DO
@@ -292 +414 @@
          !
          DO jj = mj0(jbdy1), mj1(jbdy2)
-            zvb(:,jj) = 0._wp    ! Correct transport
+            zvb(:,jj) = 0._wp 
             DO jk=1,jpkm1
                DO ji=1,jpi
@@ -308 +430 @@
          END DO
          !
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1
-            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1
+         jbdy1 = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()  
+         jbdy2 = jpjglo - ( nn_hls + 1 )
+         IF( .NOT.ln_dynspg_ts ) THEN
             DO jj = mj0(jbdy1), mj1(jbdy2)
-               zub(:,jj) = 0._wp
+               uu_b(:,jj,Krhs_a) = 0._wp
                DO jk = 1, jpkm1
                   DO ji = 1, jpi
-                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
-                  END DO
-               END DO
+                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+                  END DO
+               END DO
+               DO ji=1,jpi
+                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
+               END DO
+            END DO
+         ENDIF
+
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            zub(:,jj) = 0._wp
+            DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
-               END DO
-               DO jk = 1, jpkm1
-                  DO ji = 1, jpi
+                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+            END DO
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
                      uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+               END DO
+            END DO
+         END DO
          !
       ENDIF
@@ -349 +483 @@
       IF( lk_west ) THEN
          istart = nn_hls + 2                              ! halo + land + 1
-         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         iend   = nn_hls + 1 + nbghostcells  + nn_shift_bar*Agrif_Rhox()              ! halo + land + nbghostcells
          DO ji = mi0(istart), mi1(iend)
             DO jj=1,jpj
@@ -360 +494 @@
       !--- East ---!
       IF( lk_east ) THEN
-         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() 
+         iend   = jpiglo - ( nn_hls + 1 )                
          DO ji = mi0(istart), mi1(iend)
 
@@ -368 +502 @@
             END DO
          END DO
-         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1
+         istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox() 
+         iend   = jpiglo - ( nn_hls + 2 )                
          DO ji = mi0(istart), mi1(iend)
             DO jj=1,jpj
@@ -379 +513 @@
       !--- South ---!
       IF( lk_south ) THEN
-         jstart = nn_hls + 2                              ! halo + land + 1
-         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         jstart = nn_hls + 2                              
+         jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()           
          DO jj = mj0(jstart), mj1(jend)
 
@@ -392 +526 @@
       !--- North ---!
       IF( lk_north ) THEN
-         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()     
+         jend   = jpjglo - ( nn_hls + 1 )                
          DO jj = mj0(jstart), mj1(jend)
             DO ji=1,jpi
@@ -399 +533 @@
             END DO
          END DO
-         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1
+         jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy() 
+         jend   = jpjglo - ( nn_hls + 2 )                
          DO jj = mj0(jstart), mj1(jend)
             DO ji=1,jpi
@@ -426 +560 @@
       !--- West ---!
       IF( lk_west ) THEN
-         istart = nn_hls + 2                              ! halo + land + 1
-         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         istart = nn_hls + 2                              
+         iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox() 
          DO ji = mi0(istart), mi1(iend)
             DO jj=1,jpj
@@ -438 +572 @@
       !--- East ---!
       IF( lk_east ) THEN
-         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
+         iend   = jpiglo - ( nn_hls + 1 )                 
          DO ji = mi0(istart), mi1(iend)
             DO jj=1,jpj
@@ -445 +579 @@
             END DO
          END DO
-         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1
+         istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox() 
+         iend   = jpiglo - ( nn_hls + 2 )                 
          DO ji = mi0(istart), mi1(iend)
             DO jj=1,jpj
@@ -456 +590 @@
       !--- South ---!
       IF( lk_south ) THEN
-         jstart = nn_hls + 2                              ! halo + land + 1
-         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         jstart = nn_hls + 2                              
+         jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy() 
          DO jj = mj0(jstart), mj1(jend)
             DO ji=1,jpi
@@ -468 +602 @@
       !--- North ---!
       IF( lk_north ) THEN
-         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy() 
+         jend   = jpjglo - ( nn_hls + 1 )                
          DO jj = mj0(jstart), mj1(jend)
             DO ji=1,jpi
@@ -475 +609 @@
             END DO
          END DO
-         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1
+         jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy() 
+         jend   = jpjglo - ( nn_hls + 2 )               
          DO jj = mj0(jstart), mj1(jend)
             DO ji=1,jpi
@@ -493 +627 @@
       INTEGER, INTENT(in) ::   kt
       !!
-      INTEGER :: ji, jj
       LOGICAL :: ll_int_cons
       !!----------------------------------------------------------------------  
@@ -517 +650 @@
       !
       IF( ll_int_cons ) THEN  ! Conservative interpolation
-         ! order matters here !!!!!!
-         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
-         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
-         !
-         bdy_tinterp = 1
-         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After
-         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  )  
-         !
-         bdy_tinterp = 2
-         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before
-         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )   
+         IF ( lk_tint2d_notinterp ) THEN
+            CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b_const )
+            CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b_const ) 
+            ! Divergence conserving correction terms:
+            CALL Agrif_Bc_variable(    ub2b_cor_id, calledweight=1._wp, procname=        ub2b_cor )
+            CALL Agrif_Bc_variable(    vb2b_cor_id, calledweight=1._wp, procname=        vb2b_cor )
+         ELSE
+            ! order matters here !!!!!!
+            CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
+            CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
+            !
+            bdy_tinterp = 1
+            CALL Agrif_Bc_variable( unb_interp_id , calledweight=1._wp, procname=interpunb  ) ! After
+            CALL Agrif_Bc_variable( vnb_interp_id , calledweight=1._wp, procname=interpvnb  )  
+            !
+            bdy_tinterp = 2
+            CALL Agrif_Bc_variable( unb_interp_id , calledweight=0._wp, procname=interpunb  ) ! Before
+            CALL Agrif_Bc_variable( vnb_interp_id , calledweight=0._wp, procname=interpvnb  )   
+         ENDIF
       ELSE ! Linear interpolation
          !
          ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp 
-         CALL Agrif_Bc_variable( unb_id, procname=interpunb )
-         CALL Agrif_Bc_variable( vnb_id, procname=interpvnb )
+         CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
       ENDIF
       Agrif_UseSpecialValue = .FALSE.
@@ -561 +702 @@
       ! --- West --- !
       IF(lk_west) THEN
-         istart = nn_hls + 2                              ! halo + land + 1
-         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         istart = nn_hls + 2                                                          ! halo + land + 1
+         iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()               ! halo + land + nbghostcells
          DO ji = mi0(istart), mi1(iend)
             DO jj = 1, jpj
@@ -572 +713 @@
       ! --- East --- !
       IF(lk_east) THEN
-         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()       ! halo + land + nbghostcells - 1
+         iend   = jpiglo - ( nn_hls + 1 )                                              ! halo + land + 1            - 1
          DO ji = mi0(istart), mi1(iend)
             DO jj = 1, jpj
@@ -583 +724 @@
       ! --- South --- !
       IF(lk_south) THEN
-         jstart = nn_hls + 2                              ! halo + land + 1
-         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         jstart = nn_hls + 2                                                          ! halo + land + 1
+         jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()               ! halo + land + nbghostcells
          DO jj = mj0(jstart), mj1(jend)
             DO ji = 1, jpi
@@ -594 +735 @@
       ! --- North --- !
       IF(lk_north) THEN
-         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()     ! halo + land + nbghostcells - 1
+         jend   = jpjglo - ( nn_hls + 1 )                                            ! halo + land + 1            - 1
          DO jj = mj0(jstart), mj1(jend)
             DO ji = 1, jpi
@@ -620 +761 @@
       ! --- West --- !
       IF(lk_west) THEN
-         istart = nn_hls + 2                              ! halo + land + 1
-         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         istart = nn_hls + 2                                                        ! halo + land + 1
+         iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()             ! halo + land + nbghostcells
          DO ji = mi0(istart), mi1(iend)
             DO jj = 1, jpj
@@ -631 +772 @@
       ! --- East --- !
       IF(lk_east) THEN
-         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()    ! halo + land + nbghostcells - 1
+         iend   = jpiglo - ( nn_hls + 1 )                                           ! halo + land + 1            - 1
          DO ji = mi0(istart), mi1(iend)
             DO jj = 1, jpj
@@ -642 +783 @@
       ! --- South --- !
       IF(lk_south) THEN
-         jstart = nn_hls + 2                              ! halo + land + 1
-         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         jstart = nn_hls + 2                                                        ! halo + land + 1
+         jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()             ! halo + land + nbghostcells
          DO jj = mj0(jstart), mj1(jend)
             DO ji = 1, jpi
@@ -653 +794 @@
       ! --- North --- !
       IF(lk_north) THEN
-         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1
+         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()    ! halo + land + nbghostcells - 1
+         jend   = jpjglo - ( nn_hls + 1 )                                           ! halo + land + 1            - 1
          DO jj = mj0(jstart), mj1(jend)
             DO ji = 1, jpi
@@ -679 +820 @@
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
+      l_vremap              = ln_vert_remap
       !
       CALL Agrif_Bc_variable( avm_id, calledweight=zalpha, procname=interpavm )       
       !
       Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
       !
    END SUBROUTINE Agrif_avm
@@ -688 +831 @@
 
    SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!----------------------------------------------------------------------
-      !!                  *** ROUTINE interptsn ***
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
@@ -699 +840 @@
       INTEGER  :: item
       ! vertical interpolation:
-      REAL(wp) :: zhtot
-      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin
-      REAL(wp), DIMENSION(k1:k2) :: h_in, z_in
+      REAL(wp) :: zhtot, zwgt
+      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin, tabin_i
+      REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i
       REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
       !!----------------------------------------------------------------------
@@ -720 +861 @@
          END DO
 
-         IF( l_vremap .OR. l_ini_child) THEN
-            ! Interpolate thicknesses
+         IF( l_vremap .OR. l_ini_child .OR. ln_zps ) THEN
+
+            ! Fill cell depths (i.e. gdept) to be interpolated
             ! Warning: these are masked, hence extrapolated prior interpolation.
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                      ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
-
-                  END DO
-               END DO
-            END DO
-
-            ! Extrapolate thicknesses in partial bottom cells:
-            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
-            IF (ln_zps) THEN
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                      jk = mbkt(ji,jj)
-                      ptab(ji,jj,jk,jpts+1) = 0._wp
-                  END DO
-               END DO           
-            END IF
-        
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a)
+                  DO jk=k1+1,k2
+                     ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * &
+                        & ( ptab(ji,jj,jk-1,jpts+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) )
+                  END DO
+               END DO
+            END DO
+         
             ! Save ssh at last level:
             IF (.NOT.ln_linssh) THEN
                ptab(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 
-            ELSE
-               ptab(i1:i2,j1:j2,k2,jpts+1) = 0._wp
             END IF      
          ENDIF
@@ -758 +888 @@
          IF( l_vremap .OR. l_ini_child ) THEN
             IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp 
-               
             DO jj=j1,j2
                DO ji=i1,i2
-                  ts(ji,jj,:,:,Krhs_a) = 0.                  
-               !   IF( l_ini_child) ts(ji,jj,:,:,Krhs_a) = ptab(ji,jj,:,1:jpts)
+                  ts(ji,jj,:,:,Krhs_a) = 0.  
+                  !
+                  ! Build vertical grids:
                   N_in = mbkt_parent(ji,jj)
-                  zhtot = 0._wp
-                  DO jk=1,N_in !k2 = jpk of parent grid
-                     IF (jk==N_in) THEN
-                        h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot
-                     ELSE
-                        h_in(jk) = ptab(ji,jj,jk,n2)
-                     ENDIF
-                     zhtot = zhtot + h_in(jk)
-                     tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1)
-                  END DO
-                  z_in(1) = 0.5_wp * h_in(1) - zhtot + ht0_parent(ji,jj)
-                  DO jk=2,N_in
-                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk)
-                  END DO
-
-                  N_out = 0
-                  DO jk=1,jpk ! jpk of child grid
-                     IF (tmask(ji,jj,jk) == 0._wp) EXIT 
-                     N_out = N_out + 1
+                  ! Input grid (account for partial cells if any):
+                  DO jk=1,N_in
+                     z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
+                     tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
+                  END DO
+                  
+                  ! Intermediate grid:
+                  IF ( l_vremap ) THEN
+                     DO jk = 1, N_in
+                        h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 
+                          &       (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
+                     END DO
+                     z_in_i(1) = 0.5_wp * h_in_i(1)
+                     DO jk=2,N_in
+                        z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+                     END DO
+                     z_in_i(1:N_in) = z_in_i(1:N_in)  - ptab(ji,jj,k2,n2)
+                  ENDIF                              
+
+                  ! Output (Child) grid:
+                  N_out = mbkt(ji,jj)
+                  DO jk=1,N_out
                      h_out(jk) = e3t(ji,jj,jk,Krhs_a)
                   END DO
-
-                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj)
+                  z_out(1) = 0.5_wp * h_out(1)
                   DO jk=2,N_out
-                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk)
-                  END DO
+                     z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+                  END DO
+                  IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out)  - ssh(ji,jj,Krhs_a)
 
                   IF (N_in*N_out > 0) THEN
                      IF( l_ini_child ) THEN
-                        CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),          &
+                        CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),              &
                                       &   z_out(1:N_out),N_in,N_out,jpts)  
                      ELSE 
-                        CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),   &
+                        CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts),                       &
+                                     &   z_in_i(1:N_in),N_in,N_in,jpts)
+                        CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),   &
                                       &   h_out(1:N_out),N_in,N_out,jpts)  
                      ENDIF
@@ -806 +941 @@
          ELSE
          
-            DO jn=1, jpts
-                ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
+            IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells 
+                                             ! linear vertical interpolation
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     !
+                     N_in  = mbkt(ji,jj)
+                     N_out = mbkt(ji,jj)
+                     z_in(1) = ptab(ji,jj,1,n2)
+                     tabin(1,1:jpts) = ptab(ji,jj,1,1:jpts)
+                     DO jk=2, N_in
+                        z_in(jk) = ptab(ji,jj,jk,n2)
+                        tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
+                     END DO
+                     IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
+                     z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a)
+                     DO jk=2, N_out
+                        z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a))
+                     END DO
+                     IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
+                     CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jpts), &
+                                   &   z_out(1:N_out),N_in,N_out,jpts)  
+                  END DO
+               END DO
+            ENDIF
+
+            DO jn =1, jpts
+               ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a) = ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)
             END DO
          ENDIF
@@ -829 +989 @@
          ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a)
       ELSE
-         hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+         IF( l_ini_child ) THEN
+            ssh(i1:i2,j1:j2,Kmm_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+         ELSE
+            hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+         ENDIF
       ENDIF
       !
@@ -870 +1034 @@
          END DO
 
-        IF( l_vremap .OR. l_ini_child) THEN
+        IF( l_vremap .OR. l_ini_child ) THEN
          ! Extrapolate thicknesses in partial bottom cells:
          ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
@@ -909 +1073 @@
                   zhtot = 0._wp
                   DO jk=1,N_in
-                     IF (jk==N_in) THEN
-                        h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                     !IF (jk==N_in) THEN
+                     !   h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                     !ELSE
+                     !   h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+                     !ENDIF
+                     IF ( l_vremap ) THEN
+                        h_in(jk) = e3u0_parent(ji,jj,jk) 
                      ELSE
-                        h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+                        IF (jk==N_in) THEN
+                           h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                        ELSE
+                           h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+                        ENDIF
                      ENDIF
                      zhtot = zhtot + h_in(jk)
@@ -923 +1096 @@
                  z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj) 
                  DO jk=2,N_in
-                    z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk)
+                    z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1))
                  END DO
                      
@@ -935 +1108 @@
                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj)
                  DO jk=2,N_out
-                    z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
+                    z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk)) 
                  END DO  
 
@@ -1031 +1204 @@
                   zhtot = 0._wp
                   DO jk=1,N_in
-                     IF (jk==N_in) THEN
-                        h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                     !IF (jk==N_in) THEN
+                     !   h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                     !ELSE
+                     !   h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
+                     !ENDIF
+                     IF (l_vremap) THEN
+                        h_in(jk) = e3v0_parent(ji,jj,jk)
                      ELSE
-                        h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
+                        IF (jk==N_in) THEN
+                           h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                        ELSE
+                           h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
+                        ENDIF
                      ENDIF
                      zhtot = zhtot + h_in(jk)
@@ -1046 +1228 @@
                   z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj)
                   DO jk=2,N_in
-                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk)
+                     z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk-1)+h_in(jk))
                   END DO
 
@@ -1058 +1240 @@
                   z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj)
                   DO jk=2,N_out
-                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk)
+                     z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1)+h_out(jk))
                   END DO
  
@@ -1215 +1397 @@
    END SUBROUTINE interpub2b
    
+   SUBROUTINE interpub2b_const( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpub2b_const  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      REAL(wp) :: zrhoy
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+!         IF ( ln_bt_fw ) THEN
+            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
+!         ELSE
+!            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2)
+!         ENDIF
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         !
+         ubdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) & 
+                           & / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1)
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE interpub2b_const
+
+
+   SUBROUTINE ub2b_cor( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ub2b_cor  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      INTEGER  :: ji, jj
+      REAL(wp) :: zrhox, zrhoy, zx
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         ptab(:,:) = 0._wp
+         DO ji=i1+1,i2-1
+            DO jj=j1+1,j2
+               ptab(ji,jj) = 0.25_wp*( ( vb2_b(ji+1,jj  )*e1v(ji+1,jj  )   & 
+                           &            -vb2_b(ji-1,jj  )*e1v(ji-1,jj  ) ) &
+                           &          -( vb2_b(ji+1,jj-1)*e1v(ji+1,jj-1)   &
+                           &            -vb2_b(ji-1,jj-1)*e1v(ji-1,jj-1) ) )
+            END DO
+         END DO 
+      ELSE
+         !
+         zrhox = Agrif_Rhox() 
+         zrhoy = Agrif_Rhoy()
+         DO ji=i1,i2
+            DO jj=j1,j2
+               IF (utint_stage(ji,jj)==0) THEN 
+                  zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells-1), INT(Agrif_Rhox()))/zrhox - 1._wp  
+                  ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) & 
+                              &         / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1) 
+                  utint_stage(ji,jj) = 1 
+               ENDIF
+            END DO
+         END DO 
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE ub2b_cor
+
 
    SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before )
@@ -1252 +1501 @@
 
 
+   SUBROUTINE interpvb2b_const( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpub2b_const  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      REAL(wp) :: zrhox
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+!         IF ( ln_bt_fw ) THEN
+            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
+!         ELSE
+!            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
+!         ENDIF
+      ELSE
+         zrhox = Agrif_Rhox()
+         !
+         vbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) &
+                           & / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1)
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE interpvb2b_const
+
+ 
+   SUBROUTINE vb2b_cor( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE vb2b_cor  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      INTEGER  :: ji, jj
+      REAL(wp) :: zrhox, zrhoy, zy
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         ptab(:,:) = 0._wp
+         DO ji=i1+1,i2-1
+            DO jj=j1+1,j2
+               ptab(ji,jj) = 0.25_wp*( ( ub2_b(ji  ,jj+1)*e2u(ji  ,jj+1)   & 
+                           &            -ub2_b(ji  ,jj-1)*e2u(ji  ,jj-1) ) &
+                           &          -( ub2_b(ji-1,jj+1)*e2u(ji-1,jj+1)   &
+                           &            -ub2_b(ji-1,jj-1)*e2u(ji-1,jj-1) ) )
+            END DO
+         END DO 
+      ELSE
+         !
+         zrhox = Agrif_Rhox() 
+         zrhoy = Agrif_Rhoy()
+         DO ji=i1,i2
+            DO jj=j1,j2
+               IF (vtint_stage(ji,jj)==0) THEN 
+                  zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells-1), INT(Agrif_Rhoy()))/zrhoy - 1._wp  
+                  vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) & 
+                              &         / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1) 
+                  vtint_stage(ji,jj) = 1 
+               ENDIF
+            END DO
+         END DO 
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE vb2b_cor
+
+
    SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before )
       !!----------------------------------------------------------------------
@@ -1273 +1590 @@
                      WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  & 
                      &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), &
-                     &                 mig0(ji), mig0(jj), jk
+                     &                 mig0(ji), mjg0(jj), jk
                 !     kindic_agr = kindic_agr + 1
                   ENDIF
@@ -1283 +1600 @@
       ! 
    END SUBROUTINE interpe3t
+
+
+   SUBROUTINE interpe3t0_vremap( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpe3t0_vremap  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL                              , INTENT(in   ) :: before
+      !
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zh
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         IF ( ln_zps ) THEN
+            DO jk = k1, k2
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     ptab(ji, jj, jk) = e3t_1d(jk)
+                  END DO
+               END DO
+            END DO
+         ELSE
+            ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2)
+         ENDIF
+      ELSE
+         !
+         DO jk = k1, k2
+            DO jj = j1, j2
+               DO ji = i1, i2
+                  e3t0_parent(ji,jj,jk) = ptab(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! Retrieve correct scale factor at the bottom:
+         DO jj = j1, j2
+            DO ji = i1, i2
+               zh = 0._wp
+               DO jk = 1, mbkt_parent(ji, jj)-1
+                  zh = zh + e3t0_parent(ji,jj,jk)
+               END DO
+               e3t0_parent(ji,jj,mbkt_parent(ji,jj)) = ht0_parent(ji, jj) - zh
+            END DO
+         END DO
+         
+      ENDIF
+      ! 
+   END SUBROUTINE interpe3t0_vremap
+
 
    SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before )
@@ -1429 +1797 @@
    SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before )
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpsshn  ***
+      !!                  ***  ROUTINE interpmbkt  ***
       !!----------------------------------------------------------------------  
       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
@@ -1448 +1816 @@
    SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before )
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpsshn  ***
+      !!                  ***  ROUTINE interpht0  ***
       !!----------------------------------------------------------------------  
       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
@@ -1464 +1832 @@
    END SUBROUTINE interpht0
 
-   
-   SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before)
-       INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2
-       REAL(wp):: tabres(i1:i2,j1:j2,k1:k2,m1:m2)
-       LOGICAL :: before
-
-       INTEGER :: jm
-
-       IF (before) THEN
-         DO jm=1,jpts
-             tabres(i1:i2,j1:j2,k1:k2,jm) = ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)
-         END DO
-       ELSE
-         DO jm=1,jpts
-             ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)=tabres(i1:i2,j1:j2,k1:k2,jm)
-         END DO
-       ENDIF
-   END SUBROUTINE agrif_initts 
-
-   
-   SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpsshn  ***
-      !!----------------------------------------------------------------------  
-      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
-      LOGICAL                         , INTENT(in   ) ::   before
-      !
-      !!----------------------------------------------------------------------  
-      !
-      IF( before) THEN
-         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kbb_a)
-      ELSE
-         ssh(i1:i2,j1:j2,Kbb_a) = ptab(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1)
-      ENDIF
-      !
-   END SUBROUTINE agrif_initssh
+   SUBROUTINE Agrif_check_bat( iindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_check_bat  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(inout) ::   iindic
+      !!
+      INTEGER :: ji, jj
+      INTEGER  :: istart, iend, jstart, jend, ispon
+      !!----------------------------------------------------------------------  
+      !
+      !
+      ! --- West --- !
+      IF(lk_west) THEN
+         ispon  = nn_sponge_len * Agrif_irhox()
+         istart = nn_hls + 2                                  ! halo + land + 1
+         iend   = nn_hls + 1 + nbghostcells + ispon           ! halo + land + nbghostcells + sponge
+         jstart = nn_hls + 2
+         jend   = jpjglo - nn_hls - 1
+         DO ji = mi0(istart), mi1(iend)
+            DO jj = mj0(jstart), mj1(jend)
+               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+            DO jj = mj0(jstart), mj1(jend-1)
+               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+         DO ji = mi0(istart), mi1(iend-1)
+            DO jj = mj0(jstart), mj1(jend)
+               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+      ENDIF
+      !
+      ! --- East --- !
+      IF(lk_east) THEN
+         ispon  = nn_sponge_len * Agrif_irhox() 
+         istart = jpiglo - ( nn_hls + nbghostcells + ispon )  ! halo + land + nbghostcells + sponge - 1
+         iend   = jpiglo - ( nn_hls + 1 )                     ! halo + land + 1                     - 1
+         jstart = nn_hls + 2
+         jend   = jpjglo - nn_hls - 1 
+         DO ji = mi0(istart), mi1(iend)
+            DO jj = mj0(jstart), mj1(jend)
+               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+            DO jj = mj0(jstart), mj1(jend-1)
+               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+         DO ji = mi0(istart+1), mi1(iend-1)
+            DO jj = mj0(jstart), mj1(jend)
+               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+      ENDIF
+      !
+      ! --- South --- !
+      IF(lk_south) THEN
+         ispon  = nn_sponge_len * Agrif_irhoy() 
+         jstart = nn_hls + 2                                 ! halo + land + 1
+         jend   = nn_hls + 1 + nbghostcells + ispon          ! halo + land + nbghostcells + sponge
+         istart = nn_hls + 2
+         iend   = jpiglo - nn_hls - 1
+         DO jj = mj0(jstart), mj1(jend)
+            DO ji = mi0(istart), mi1(iend)
+               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+            DO ji = mi0(istart), mi1(iend-1)
+               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+         DO jj = mj0(jstart), mj1(jend-1)
+            DO ji = mi0(istart), mi1(iend)
+               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+      ENDIF
+      !
+      ! --- North --- !
+      IF(lk_north) THEN
+         ispon  = nn_sponge_len * Agrif_irhoy() 
+         jstart = jpjglo - ( nn_hls + nbghostcells + ispon)  ! halo + land + nbghostcells +sponge - 1
+         jend   = jpjglo - ( nn_hls + 1 )                    ! halo + land + 1            - 1
+         istart = nn_hls + 2
+         iend   = jpiglo - nn_hls - 1
+         DO jj = mj0(jstart), mj1(jend)
+            DO ji = mi0(istart), mi1(iend)
+               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+            DO ji = mi0(istart), mi1(iend-1)
+               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+         DO jj = mj0(jstart+1), mj1(jend-1)
+            DO ji = mi0(istart), mi1(iend)
+               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE Agrif_check_bat
    
 #else

NEMO/trunk/src/NST/agrif_oce_sponge.F90

@@ -28 +28 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC Agrif_Sponge, Agrif_Sponge_2d, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
    PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+   PUBLIC interpunb_sponge, interpvnb_sponge
 
    !! * Substitutions
@@ -46 +47 @@
       !!----------------------------------------------------------------------
       REAL(wp) ::   zcoef   ! local scalar
-      
+      INTEGER  :: istart, iend, jstart, jend 
       !!----------------------------------------------------------------------
       !
@@ -53 +54 @@
       zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
 
-      CALL Agrif_Sponge
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      l_vremap              = ln_vert_remap
       tabspongedone_tsn     = .FALSE.
       !
-      CALL Agrif_Bc_Variable( tsn_sponge_id, calledweight=zcoef, procname=interptsn_sponge )
+      CALL Agrif_Bc_Variable( ts_sponge_id, calledweight=zcoef, procname=interptsn_sponge )
       !
       Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
 #endif
       !
@@ -81 +83 @@
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = ln_spc_dyn
+      l_vremap              = ln_vert_remap
       use_sign_north        = .TRUE.
       sign_north            = -1._wp
@@ -91 +94 @@
       tabspongedone_v = .FALSE.
       CALL Agrif_Bc_Variable( vn_sponge_id, calledweight=zcoef, procname=interpvn_sponge )
+      
+      IF ( nn_shift_bar>0 ) THEN ! then split sponge between 2d and 3d
+         zcoef = REAL(Agrif_NbStepint(),wp)/REAL(Agrif_rhot()) ! forward tsplit
+         tabspongedone_u = .FALSE.
+         tabspongedone_v = .FALSE.         
+         CALL Agrif_Bc_Variable( unb_sponge_id, calledweight=zcoef, procname=interpunb_sponge )
+         !
+         tabspongedone_u = .FALSE.
+         tabspongedone_v = .FALSE.
+         CALL Agrif_Bc_Variable( vnb_sponge_id, calledweight=zcoef, procname=interpvnb_sponge )
+      ENDIF
       !
       Agrif_UseSpecialValue = .FALSE.
       use_sign_north        = .FALSE.
+      l_vremap              = .FALSE.
+      !
 #endif
       !
@@ -110 +126 @@
       REAL(wp) ::   z1_ispongearea, z1_jspongearea
       REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
-#if defined key_vertical
-      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu
-      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv
-#endif
-      REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast
-      REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth
       !!----------------------------------------------------------------------
       !
@@ -124 +134 @@
       !|            |           |           |           |
       !fine :     t u t u t u t u t u t u t u t u t u t u t
-      !sponge val:0   0   0   1  5/6 4/6 3/6 2/6 1/6  0   0
+      !sponge val:0 1   1   1   1  5/6 4/6 3/6 2/6 1/6  0 
       !           |   ghost     | <-- sponge area  -- > |
       !           |   points    |                       |
@@ -130 +140 @@
 
 #if defined SPONGE || defined SPONGE_TOP
-      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
-         !
-         ! Retrieve masks at open boundaries:
-
-         IF( lk_west ) THEN                             ! --- West --- !
-            ztabramp(:,:) = 0._wp
-            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            DO ji = mi0(ind1), mi1(ind1)                
-               ztabramp(ji,:) = ssumask(ji,:)
-            END DO
-            zmskwest(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1)
-            zmskwest(jpj+1:jpjmax) = 0._wp
-         ENDIF
-         IF( lk_east ) THEN                             ! --- East --- !
-            ztabramp(:,:) = 0._wp
-            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-            DO ji = mi0(ind1), mi1(ind1)                 
-               ztabramp(ji,:) = ssumask(ji,:)
-            END DO
-            zmskeast(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1)
-            zmskeast(jpj+1:jpjmax) = 0._wp
-         ENDIF
-         IF( lk_south ) THEN                            ! --- South --- !
-            ztabramp(:,:) = 0._wp
-            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            DO jj = mj0(ind1), mj1(ind1)                 
-               ztabramp(:,jj) = ssvmask(:,jj)
-            END DO
-            zmsksouth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2)
-            zmsksouth(jpi+1:jpimax) = 0._wp
-         ENDIF
-         IF( lk_north ) THEN                            ! --- North --- !
-            ztabramp(:,:) = 0._wp
-            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
-            DO jj = mj0(ind1), mj1(ind1)                 
-               ztabramp(:,jj) = ssvmask(:,jj)
-            END DO
-            zmsknorth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2)
-            zmsknorth(jpi+1:jpimax) = 0._wp
-         ENDIF
-
-         ! JC: SPONGE MASKING TO BE SORTED OUT:
-         zmskwest(:)  = 1._wp
-         zmskeast(:)  = 1._wp
-         zmsksouth(:) = 1._wp
-         zmsknorth(:) = 1._wp
-#if defined key_mpp_mpi
-!         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax )
-!         CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax )
-!         CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax )
-!         CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax )
+      ! Define ramp from boundaries towards domain interior at F-points
+      ! Store it in ztabramp
+
+      ispongearea    = nn_sponge_len * Agrif_irhox()
+      z1_ispongearea = 1._wp / REAL( MAX(ispongearea,1), wp )
+      jspongearea    = nn_sponge_len * Agrif_irhoy()
+      z1_jspongearea = 1._wp / REAL( MAX(jspongearea,1), wp )
+         
+      ztabramp(:,:) = 0._wp
+
+      IF( lk_west ) THEN                             ! --- West --- !
+         ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         ind2 = nn_hls + 1 + nbghostcells + ispongearea 
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF
+      IF( lk_east ) THEN                             ! --- East --- !
+         ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea - 1
+         ind2 = jpiglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1
+         DO ji = mi0(ind1), mi1(ind2)
+            DO jj = 1, jpj
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) 
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = jpiglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1
+         ind2 = jpiglo - 1
+         DO ji = mi0(ind1), mi1(ind2)
+            DO jj = 1, jpj
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF      
+      IF( lk_south ) THEN                            ! --- South --- !
+         ind1 = nn_hls + 1 + nbghostcells                 ! halo + land + nbghostcells
+         ind2 = nn_hls + 1 + nbghostcells + jspongearea 
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nn_hls + 1 + nbghostcells                 ! halo + land + nbghostcells
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF
+      IF( lk_north ) THEN                            ! --- North --- !
+         ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea - 1
+         ind2 = jpjglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) 
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
+         ind2 = jpjglo
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF      
+      !
+      ! Tracers
+      fspu(:,:) = 0._wp
+      fspv(:,:) = 0._wp
+      DO_2D( 0, 0, 0, 0 )
+         fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji,jj-1) ) * ssumask(ji,jj)
+         fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji-1,jj) ) * ssvmask(ji,jj)
+      END_2D
+
+      ! Dynamics
+      fspt(:,:) = 0._wp
+      fspf(:,:) = 0._wp
+      DO_2D( 0, 0, 0, 0 )
+         fspt(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji-1,jj  ) &
+                               &  +ztabramp(ji  ,jj-1) + ztabramp(ji-1,jj-1) ) * ssmask(ji,jj)
+         fspf(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1)
+      END_2D
+      
+      CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp )
+      !
+      ! Remove vertical interpolation where not needed:
+      ! (A null value in mbkx arrays does the job)
+      WHERE (fspu(:,:) == 0._wp) mbku_parent(:,:) = 0
+      WHERE (fspv(:,:) == 0._wp) mbkv_parent(:,:) = 0
+      WHERE (fspt(:,:) == 0._wp) mbkt_parent(:,:) = 0
+      !
 #endif
-
-         ! Define ramp from boundaries towards domain interior at T-points
-         ! Store it in ztabramp
-
-         ispongearea    = nn_sponge_len * Agrif_irhox()
-         z1_ispongearea = 1._wp / REAL( ispongearea, wp )
-         jspongearea    = nn_sponge_len * Agrif_irhoy()
-         z1_jspongearea = 1._wp / REAL( jspongearea, wp )
-         
-         ztabramp(:,:) = 0._wp
-
-         ! Trick to remove sponge in 2DV domains:
-         IF ( nbcellsx <= 3 ) ispongearea = -1
-         IF ( nbcellsy <= 3 ) jspongearea = -1
-
-         IF( lk_west ) THEN                             ! --- West --- !
-            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            ind2 = nn_hls + 1 + nbghostcells + ispongearea 
-            DO ji = mi0(ind1), mi1(ind2)   
-               DO jj = 1, jpj               
-                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea   * zmskwest(jj)
-               END DO
-            END DO
-            ! ghost cells:
-            ind1 = 1
-            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            DO ji = mi0(ind1), mi1(ind2)   
-               DO jj = 1, jpj               
-                  ztabramp(ji,jj) = zmskwest(jj)
-               END DO
-            END DO
-         ENDIF
-         IF( lk_east ) THEN                             ! --- East --- !
-            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea
-            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-            DO ji = mi0(ind1), mi1(ind2)
-               DO jj = 1, jpj
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj)
-               END DO
-            END DO
-            ! ghost cells:
-            ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-            ind2 = jpiglo
-            DO ji = mi0(ind1), mi1(ind2)
-               DO jj = 1, jpj
-                  ztabramp(ji,jj) = zmskeast(jj)
-               END DO
-            END DO
-         ENDIF      
-         IF( lk_south ) THEN                            ! --- South --- !
-            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            ind2 = nn_hls + 1 + nbghostcells + jspongearea 
-            DO jj = mj0(ind1), mj1(ind2) 
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji)
-               END DO
-            END DO
-            ! ghost cells:
-            ind1 = 1
-            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
-            DO jj = mj0(ind1), mj1(ind2) 
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = zmsksouth(ji)
-               END DO
-            END DO
-         ENDIF
-         IF( lk_north ) THEN                            ! --- North --- !
-            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea
-            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-            DO jj = mj0(ind1), mj1(ind2)
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji)
-               END DO
-            END DO
-            ! ghost cells:
-            ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
-            ind2 = jpjglo
-            DO jj = mj0(ind1), mj1(ind2)
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = zmsknorth(ji)
-               END DO
-            END DO
-         ENDIF
-         !
+      !
+   END SUBROUTINE Agrif_Sponge
+
+
+   SUBROUTINE Agrif_Sponge_2d
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE  Agrif_Sponge_2d ***
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, ind1, ind2, ishift, jshift
+      INTEGER  ::   ispongearea, jspongearea
+      REAL(wp) ::   z1_ispongearea, z1_jspongearea
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
+      !!----------------------------------------------------------------------
+      !
+      ! Sponge 1d example with:
+      !      iraf = 3 ; nbghost = 3 ; nn_sponge_len = 2
+      !                        
+      !coarse :     U     T     U     T     U     T     U
+      !|            |           |           |           |
+      !fine :     t u t u t u t u t u t u t u t u t u t u t
+      !sponge val:0 1   1   1   1  5/6 4/6 3/6 2/6 1/6  0 
+      !           |   ghost     | <-- sponge area  -- > |
+      !           |   points    |                       |
+      !                         |--> dynamical interface
+
+#if defined SPONGE || defined SPONGE_TOP
+      ! Define ramp from boundaries towards domain interior at F-points
+      ! Store it in ztabramp
+
+      ispongearea    = nn_sponge_len * Agrif_irhox()
+      z1_ispongearea = 1._wp / REAL( MAX(ispongearea,1), wp )
+      jspongearea    = nn_sponge_len * Agrif_irhoy()
+      z1_jspongearea = 1._wp / REAL( MAX(jspongearea,1), wp )
+      ishift = nn_shift_bar * Agrif_irhox()
+      jshift = nn_shift_bar * Agrif_irhoy()
+        
+      ztabramp(:,:) = 0._wp
+
+      IF( lk_west ) THEN                             ! --- West --- !
+         ind1 = nn_hls + 1 + nbghostcells + ishift
+         ind2 = nn_hls + 1 + nbghostcells + ishift + ispongearea 
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nn_hls + 1 + nbghostcells + ishift               ! halo + land + nbghostcells
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
       ENDIF
-
+      IF( lk_east ) THEN                             ! --- East --- !
+         ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - ispongearea - 1
+         ind2 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1    ! halo + land + nbghostcells - 1
+         DO ji = mi0(ind1), mi1(ind2)
+            DO jj = 1, jpj
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) 
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1    ! halo + land + nbghostcells - 1
+         ind2 = jpiglo - 1
+         DO ji = mi0(ind1), mi1(ind2)
+            DO jj = 1, jpj
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF      
+      IF( lk_south ) THEN                            ! --- South --- !
+         ind1 = nn_hls + 1 + nbghostcells + jshift                ! halo + land + nbghostcells
+         ind2 = nn_hls + 1 + nbghostcells + jshift + jspongearea 
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nn_hls + 1 + nbghostcells + jshift                ! halo + land + nbghostcells
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF
+      IF( lk_north ) THEN                            ! --- North --- !
+         ind1 = jpjglo - ( nn_hls + nbghostcells + jshift) - jspongearea - 1
+         ind2 = jpjglo - ( nn_hls + nbghostcells + jshift) - 1    ! halo + land + nbghostcells - 1
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) 
+            END DO
+         END DO
+         ! ghost cells:
+         ind1 = jpjglo - ( nn_hls + nbghostcells + jshift)      ! halo + land + nbghostcells - 1
+         ind2 = jpjglo
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = 1._wp
+            END DO
+         END DO
+      ENDIF
+      !
       ! Tracers
-      IF( .NOT. spongedoneT ) THEN
-         fspu(:,:) = 0._wp
-         fspv(:,:) = 0._wp
-         DO_2D( 0, 0, 0, 0 )
-            fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) * ssumask(ji,jj)
-            fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj)
+      fspu_2d(:,:) = 0._wp
+      fspv_2d(:,:) = 0._wp
+      DO_2D( 0, 0, 0, 0 )
+         fspu_2d(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji,jj-1) ) * ssumask(ji,jj)
+         fspv_2d(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji-1,jj) ) * ssvmask(ji,jj)
+      END_2D
+
+      ! Dynamics
+      fspt_2d(:,:) = 0._wp
+      fspf_2d(:,:) = 0._wp
+      DO_2D( 0, 0, 0, 0 )
+         fspt_2d(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji-1,jj  ) &
+                               &  +ztabramp(ji  ,jj-1) + ztabramp(ji-1,jj-1) ) * ssmask(ji,jj)
+         fspf_2d(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1)
          END_2D
-      ENDIF
-
-      ! Dynamics
-      IF( .NOT. spongedoneU ) THEN
-         fspt(:,:) = 0._wp
-         fspf(:,:) = 0._wp
-         DO_2D( 0, 0, 0, 0 )
-            fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj)
-            fspf(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1)   &
-                                  &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) &
-                                  &  * ssvmask(ji,jj) * ssvmask(ji,jj+1)
-         END_2D
-      ENDIF
-      
-      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN
-         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp )
-         spongedoneT = .TRUE.
-         spongedoneU = .TRUE.
-      ENDIF
-      IF( .NOT. spongedoneT ) THEN
-         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp )
-         spongedoneT = .TRUE.
-      ENDIF
-      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN
-         CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp )
-         spongedoneU = .TRUE.
-      ENDIF
-
-#if defined key_vertical
-      ! Remove vertical interpolation where not needed:
-      DO_2D( 0, 0, 0, 0 )
-         IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. &
-         &   (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0
-!
-         IF ((fspt(ji+1,jj)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
-         &   (fspf(ji,jj-1)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbku_parent(ji,jj) = 0
-!
-         IF ((fspt(ji,jj+1)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
-         &   (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0
-!
-         IF ( ssmask(ji,jj) == 0._wp) mbkt_parent(ji,jj) = 0
-         IF (ssumask(ji,jj) == 0._wp) mbku_parent(ji,jj) = 0
-         IF (ssvmask(ji,jj) == 0._wp) mbkv_parent(ji,jj) = 0
-      END_2D
-      !
-      ztabramp (:,:) = REAL( mbkt_parent(:,:), wp )
-      ztabrampu(:,:) = REAL( mbku_parent(:,:), wp )
-      ztabrampv(:,:) = REAL( mbkv_parent(:,:), wp )
-      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp )
-      mbkt_parent(:,:) = NINT( ztabramp (:,:) )
-      mbku_parent(:,:) = NINT( ztabrampu(:,:) )
-      mbkv_parent(:,:) = NINT( ztabrampv(:,:) )
+      CALL lbc_lnk_multi( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp )
+      !
 #endif
       !
-#endif
-      !
-   END SUBROUTINE Agrif_Sponge
-
-   
-   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+   END SUBROUTINE Agrif_Sponge_2d
+
+
+   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE interptsn_sponge ***
@@ -346 +386 @@
       INTEGER  ::   iku, ikv
       REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot
-      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv
+      REAL(wp), DIMENSION(i1-1:i2,j1-1:j2,jpk) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff
       ! vertical interpolation:
       REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child
-      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
-      REAL(wp), DIMENSION(k1:k2) :: h_in
-      REAL(wp), DIMENSION(1:jpk) :: h_out
+      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin, tabin_i
+      REAL(wp), DIMENSION(k1:k2) :: z_in, z_in_i, h_in_i
+      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
       INTEGER :: N_in, N_out
       !!----------------------------------------------------------------------
@@ -367 +407 @@
          END DO
 
-# if defined key_vertical
-        ! Interpolate thicknesses
-        ! Warning: these are masked, hence extrapolated prior interpolation.
-        DO jk=k1,k2
-           DO jj=j1,j2
-              DO ji=i1,i2
-                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a)
-              END DO
-           END DO
-        END DO
-
-        ! Extrapolate thicknesses in partial bottom cells:
-        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
-        IF (ln_zps) THEN
-           DO jj=j1,j2
-              DO ji=i1,i2
-                  jk = mbkt(ji,jj)
-                  tabres(ji,jj,jk,jpts+1) = 0._wp
-              END DO
-           END DO           
-        END IF
-     
-        ! Save ssh at last level:
-        IF (.NOT.ln_linssh) THEN
-           tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1) 
-        ELSE
-           tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp
-        END IF      
-# endif
-
-      ELSE   
-         !
-# if defined key_vertical
-
-         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
-
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres_child(ji,jj,:,:) = 0._wp 
-               N_in = mbkt_parent(ji,jj)
-               zhtot = 0._wp
-               DO jk=1,N_in !k2 = jpk of parent grid
-                  IF (jk==N_in) THEN
-                     h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot
+         IF ( l_vremap.OR.ln_zps ) THEN
+
+            ! Fill cell depths (i.e. gdept) to be interpolated
+            ! Warning: these are masked, hence extrapolated prior interpolation.
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kbb_a)
+                  DO jk=k1+1,k2
+                     tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * &
+                        & ( tabres(ji,jj,jk-1,jpts+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a)+e3t(ji,jj,jk,Kbb_a)) )
+                  END DO
+               END DO
+            END DO
+
+            ! Save ssh at last level:
+            IF ( .NOT.ln_linssh ) THEN
+               tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1) 
+            END IF  
+    
+         END IF
+
+      ELSE 
+         !
+         IF ( l_vremap ) THEN
+
+            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+
+                  tabres_child(ji,jj,:,:) = 0._wp 
+                  ! Build vertical grids:
+                  N_in = mbkt_parent(ji,jj)
+                  ! Input grid (account for partial cells if any):
+                  DO jk=1,N_in
+                     z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2)
+                     tabin(jk,1:jpts) = tabres(ji,jj,jk,1:jpts)
+                  END DO
+                  
+                  ! Intermediate grid:
+                  DO jk = 1, N_in
+                     h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 
+                       &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
+                  END DO
+                  z_in_i(1) = 0.5_wp * h_in_i(1)
+                  DO jk=2,N_in
+                     z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+                  END DO
+                  z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2)
+
+                  ! Output (Child) grid:
+                  N_out = mbkt(ji,jj)
+                  DO jk=1,N_out
+                     h_out(jk) = e3t(ji,jj,jk,Kbb_a)
+                  END DO
+                  z_out(1) = 0.5_wp * h_out(1)
+                  DO jk=2,N_out
+                     z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+                  END DO
+                  IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out)  - ssh(ji,jj,Kbb_a)
+
+                  ! Account for small differences in the free-surface
+                  IF ( sum(h_out(1:N_out)) > sum(h_in_i(1:N_in) )) THEN
+                     h_out(1) = h_out(1)  - ( sum(h_out(1:N_out))-sum(h_in_i(1:N_in)) )
                   ELSE
-                     h_in(jk) = tabres(ji,jj,jk,n2)
+                     h_in_i(1)= h_in_i(1) - ( sum(h_in_i(1:N_in))-sum(h_out(1:N_out)) )
+                  END IF
+                  IF (N_in*N_out > 0) THEN
+                     CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts),z_in_i(1:N_in),N_in,N_in,jpts)
+                     CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
+!                     CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),z_out(1:N_in),N_in,N_out,jpts)  
                   ENDIF
-                  zhtot = zhtot + h_in(jk)
-                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
-               END DO
-               N_out = 0
-               DO jk=1,jpk ! jpk of child grid
-                  IF (tmask(ji,jj,jk) == 0) EXIT 
-                  N_out = N_out + 1
-                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
-               END DO
-
-               ! Account for small differences in free-surface
-               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
-                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
-               ELSE
-                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
-               ENDIF
-               IF (N_in*N_out > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
-               ENDIF
-            END DO
-         END DO
-# endif
-
-         DO jj=j1,j2
-            DO ji=i1,i2
-               DO jk=1,jpkm1
-# if defined key_vertical
-                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk)
-# else
-                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk)
-# endif
-               END DO
-            END DO
-         END DO
+               END DO
+            END DO
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  DO jk=1,jpkm1
+                     tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+         ELSE
+
+            IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells
+
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     !
+                     N_in  = mbkt(ji,jj) 
+                     N_out = mbkt(ji,jj) 
+                     z_in(1) = tabres(ji,jj,1,n2)
+                     tabin(1,1:jpts) = tabres(ji,jj,1,1:jpts)
+                     DO jk=2, N_in
+                        z_in(jk) = tabres(ji,jj,jk,n2)
+                        tabin(jk,1:jpts) = tabres(ji,jj,jk,1:jpts)
+                     END DO 
+                     IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - tabres(ji,jj,k2,n2)
+
+                     z_out(1) = 0.5_wp * e3t(ji,jj,1,Kbb_a)
+                     DO jk=2, N_out
+                        z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk,Kbb_a)) 
+                     END DO 
+                     IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
+
+                     CALL remap_linear(tabin(1:N_in,1:jpts), z_in(1:N_in), tabres(ji,jj,1:N_out,1:jpts), &
+                                         &   z_out(1:N_out), N_in, N_out, jpts)
+                  END DO
+               END DO
+            ENDIF
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  DO jk=1,jpkm1
+                     tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+         END IF
 
          DO jn = 1, jpts            
             DO jk = 1, jpkm1
-               ztu(i1:i2,j1:j2,jk) = 0._wp
+               ztu(i1-1:i2,j1-1:j2,jk) = 0._wp
                DO jj = j1,j2
                   DO ji = i1,i2-1
-                     zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
-                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
-                  END DO
-               END DO
-               ztv(i1:i2,j1:j2,jk) = 0._wp
+                     zabe1 = rn_sponge_tra * r1_Dt * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
+                     ztu(ji,jj,jk) = zabe1 * fspu(ji,jj) * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
+                  END DO
+               END DO
+               ztv(i1-1:i2,j1-1:j2,jk) = 0._wp
                DO ji = i1,i2
                   DO jj = j1,j2-1
-                     zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
-                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                     zabe2 = rn_sponge_tra * r1_Dt * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
+                     ztv(ji,jj,jk) = zabe2 * fspv(ji,jj) * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
                   END DO
                END DO
@@ -479 +559 @@
             END DO
             !
+! JC: there is something wrong with the Laplacian in corners
             DO jk = 1, jpkm1
-               DO jj = j1+1,j2-1
-                  DO ji = i1+1,i2-1
+               DO jj = j1,j2
+                  DO ji = i1,i2
                      IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
                         zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)
                         ! horizontal diffusive trends
-                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) &
-                             &  - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn) 
+                        ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
+                          &           + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
+                          &   - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn)
                         ! add it to the general tracer trends
                         ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa
@@ -492 +574 @@
                   END DO
                END DO
+
             END DO
             !
          END DO
          !
-         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+         tabspongedone_tsn(i1:i2,j1:j2) = .TRUE.
          !
       ENDIF
@@ -529 +612 @@
                DO ji=i1,i2
                   tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a)
-# if defined key_vertical
-                  tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk)
-# endif
-               END DO
-            END DO
-         END DO
-
-# if defined key_vertical
-         ! Extrapolate thicknesses in partial bottom cells:
-         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
-         IF (ln_zps) THEN
+               END DO
+            END DO
+         END DO
+
+         IF ( l_vremap ) THEN
+
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+            ! Extrapolate thicknesses in partial bottom cells:
+            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+            IF (ln_zps) THEN
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     jk = mbku(ji,jj)
+                     tabres(ji,jj,jk,m2) = 0._wp
+                  END DO
+               END DO           
+            END IF
+            ! Save ssh at last level:
+            tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+            IF (.NOT.ln_linssh) THEN
+               ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
+               DO jk=1,jpk
+                  tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
+               END DO
+               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2)
+            END IF 
+         END IF
+
+      ELSE
+
+         IF ( l_vremap ) THEN
+
+            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+
             DO jj=j1,j2
                DO ji=i1,i2
-                  jk = mbku(ji,jj)
-                  tabres(ji,jj,jk,m2) = 0._wp
-               END DO
-            END DO           
-         END IF
-        ! Save ssh at last level:
-        tabres(i1:i2,j1:j2,k2,m2) = 0._wp
-        IF (.NOT.ln_linssh) THEN
-           ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
-           DO jk=1,jpk
-              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
-           END DO
-           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2)
-        END IF 
-# endif
-
-      ELSE
-
-# if defined key_vertical
-         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
-
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres_child(ji,jj,:) = 0._wp
-               N_in = mbku_parent(ji,jj)
-               zhtot = 0._wp
-               DO jk=1,N_in
-                  IF (jk==N_in) THEN
-                     h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                  tabres_child(ji,jj,:) = 0._wp
+                  N_in = mbku_parent(ji,jj)
+                  zhtot = 0._wp
+                  DO jk=1,N_in
+                     !IF (jk==N_in) THEN
+                     !   h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                     !ELSE
+                     !   h_in(jk) = tabres(ji,jj,jk,m2)
+                     !ENDIF
+                     h_in(jk) = e3u0_parent(ji,jj,jk)
+                     zhtot = zhtot + h_in(jk)
+                     tabin(jk) = tabres(ji,jj,jk,m1)
+                  END DO
+                  !         
+                  N_out = 0
+                  DO jk=1,jpk
+                     IF (umask(ji,jj,jk) == 0) EXIT
+                     N_out = N_out + 1
+                     h_out(N_out) = e3u(ji,jj,jk,Kbb_a)
+                  END DO
+
+                  ! Account for small differences in free-surface
+                  IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
+                     h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
                   ELSE
-                     h_in(jk) = tabres(ji,jj,jk,m2)
+                     h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
                   ENDIF
-                  zhtot = zhtot + h_in(jk)
-                  tabin(jk) = tabres(ji,jj,jk,m1)
-               END DO
-               !         
-               N_out = 0
-               DO jk=1,jpk
-                  IF (umask(ji,jj,jk) == 0) EXIT
-                  N_out = N_out + 1
-                  h_out(N_out) = e3u(ji,jj,jk,Kbb_a)
-               END DO
-
-               ! Account for small differences in free-surface
-               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
-                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
-               ELSE
-                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
-               ENDIF
                   
-               IF (N_in * N_out > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
-               ENDIF 
-            END DO
-         END DO
-
-         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)
-#else
-         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)
-#endif
+                  IF (N_in * N_out > 0) THEN
+                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+                  ENDIF 
+               END DO
+            END DO
+
+            ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)
+         ELSE
+
+            ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)
+  
+         ENDIF
          !
          DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -706 +799 @@
                DO ji=i1,i2
                   tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a)
-# if defined key_vertical
-                  tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a)
-# endif
-               END DO
-            END DO
-         END DO
-
-# if defined key_vertical
-         ! Extrapolate thicknesses in partial bottom cells:
-         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
-         IF (ln_zps) THEN
+               END DO
+            END DO
+         END DO
+
+         IF ( l_vremap ) THEN
+
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a)
+                  END DO
+               END DO
+            END DO
+            ! Extrapolate thicknesses in partial bottom cells:
+            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+            IF (ln_zps) THEN
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     jk = mbkv(ji,jj)
+                     tabres(ji,jj,jk,m2) = 0._wp
+                  END DO
+               END DO           
+            END IF
+            ! Save ssh at last level:
+            tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+            IF (.NOT.ln_linssh) THEN
+               ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
+               DO jk=1,jpk
+                  tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
+               END DO
+               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2)
+            END IF
+
+         END IF 
+
+      ELSE
+
+         IF ( l_vremap ) THEN
+            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
             DO jj=j1,j2
                DO ji=i1,i2
-                  jk = mbkv(ji,jj)
-                  tabres(ji,jj,jk,m2) = 0._wp
-               END DO
-            END DO           
-         END IF
-        ! Save ssh at last level:
-        tabres(i1:i2,j1:j2,k2,m2) = 0._wp
-        IF (.NOT.ln_linssh) THEN
-           ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
-           DO jk=1,jpk
-              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
-           END DO
-           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2)
-        END IF 
-# endif
-
-      ELSE
-
-# if defined key_vertical
-         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres_child(ji,jj,:) = 0._wp
-               N_in = mbkv_parent(ji,jj)
-               zhtot = 0._wp
-               DO jk=1,N_in
-                  IF (jk==N_in) THEN
-                     h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                  tabres_child(ji,jj,:) = 0._wp
+                  N_in = mbkv_parent(ji,jj)
+                  zhtot = 0._wp
+                  DO jk=1,N_in
+                     !IF (jk==N_in) THEN
+                     !   h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                     !ELSE
+                     !   h_in(jk) = tabres(ji,jj,jk,m2)
+                     !ENDIF
+                     h_in(jk) = e3v0_parent(ji,jj,jk)
+                     zhtot = zhtot + h_in(jk)
+                     tabin(jk) = tabres(ji,jj,jk,m1)
+                  END DO
+                  !          
+                  N_out = 0
+                  DO jk=1,jpk
+                     IF (vmask(ji,jj,jk) == 0) EXIT
+                     N_out = N_out + 1
+                     h_out(N_out) = e3v(ji,jj,jk,Kbb_a)
+                  END DO
+
+                  ! Account for small differences in free-surface
+                  IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
+                     h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
                   ELSE
-                     h_in(jk) = tabres(ji,jj,jk,m2)
+                     h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
                   ENDIF
-                  zhtot = zhtot + h_in(jk)
-                  tabin(jk) = tabres(ji,jj,jk,m1)
-               END DO
-               !          
-               N_out = 0
-               DO jk=1,jpk
-                  IF (vmask(ji,jj,jk) == 0) EXIT
-                  N_out = N_out + 1
-                  h_out(N_out) = e3v(ji,jj,jk,Kbb_a)
-               END DO
-
-               ! Account for small differences in free-surface
-               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
-                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
-               ELSE
-                  h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
-               ENDIF
          
-               IF (N_in * N_out > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
-               ENDIF
-            END DO
-         END DO
-
-         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)  
-# else
-         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)
-# endif
+                  IF (N_in * N_out > 0) THEN
+                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+                  ENDIF
+               END DO
+            END DO
+
+            vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)  
+         ELSE
+
+            vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)
+
+         ENDIF
          !
          DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -840 +942 @@
       !
    END SUBROUTINE interpvn_sponge
+
+   SUBROUTINE interpunb_sponge(tabres,i1,i2,j1,j2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpunb_sponge ***
+      !!---------------------------------------------    
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER  :: ji, jj, ind1, jmax
+      ! sponge parameters 
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ubdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: rotdiff, hdivdiff
+      !!---------------------------------------------    
+      !
+      IF( before ) THEN
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = uu_b(ji,jj,Kmm_a)
+            END DO
+         END DO
+
+      ELSE
+
+         ubdiff(i1:i2,j1:j2) = (uu_b(i1:i2,j1:j2,Kmm_a) - tabres(i1:i2,j1:j2))*umask(i1:i2,j1:j2,1)
+         !
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = j1,j2
+            DO ji = i1+1,i2   ! vector opt.
+               zbtr = rn_sponge_dyn * r1_Dt * fspt_2d(ji,jj) * r1_ht_0(ji,jj)
+               hdivdiff(ji,jj) = (  e2u(ji  ,jj)*hu(ji  ,jj,Kbb_a) * ubdiff(ji  ,jj) &
+                                  &-e2u(ji-1,jj)*hu(ji-1,jj,Kbb_a) * ubdiff(ji-1,jj) ) * zbtr
+            END DO
+         END DO
+
+         DO jj = j1,j2-1
+            DO ji = i1,i2   ! vector opt.
+               zbtr = rn_sponge_dyn * r1_Dt * fspf_2d(ji,jj) * hf_0(ji,jj)
+               rotdiff(ji,jj) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1)   &
+                              &   +e1u(ji,jj  ) * ubdiff(ji,jj  ) ) * fmask(ji,jj,1) * zbtr 
+            END DO
+         END DO
+         !
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  ze2u = rotdiff (ji,jj)
+                  ze1v = hdivdiff(ji,jj)
+                  ! horizontal diffusive trends
+                  zua = - ( ze2u - rotdiff (ji,jj-1) ) * r1_e2u(ji,jj) * r1_hu(ji,jj,Kmm_a)  &
+                      & + ( hdivdiff(ji+1,jj) - ze1v ) * r1_e1u(ji,jj)                       & 
+                      & - rn_trelax_dyn * r1_Dt * fspu_2d(ji,jj) * ubdiff(ji,jj)
+
+                  ! add it to the general momentum trends
+                  uu(ji,jj,:,Krhs_a) = uu(ji,jj,:,Krhs_a) + zua                                 
+               ENDIF
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+         jmax = j2-1
+         ind1 = jpjglo - ( nn_hls + nbghostcells + 2 )   ! North
+         DO jj = mj0(ind1), mj1(ind1)                 
+            jmax = MIN(jmax,jj)
+         END DO
+
+         DO jj = j1+1, jmax
+            DO ji = i1+1, i2   ! vector opt.
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                     ze2u = rotdiff (ji,jj)
+                     ze1v = hdivdiff(ji,jj)
+                     zva = + ( ze2u - rotdiff (ji-1,jj) ) * r1_e1v(ji,jj) * r1_hv(ji,jj,Kmm_a) &
+                           + ( hdivdiff(ji,jj+1) - ze1v ) * r1_e2v(ji,jj)
+                     vv(ji,jj,:,Krhs_a) = vv(ji,jj,:,Krhs_a) + zva
+               ENDIF
+            END DO
+         END DO
+         !
+         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
+         !
+      ENDIF
+      !
+   END SUBROUTINE interpunb_sponge
+
+   
+   SUBROUTINE interpvnb_sponge(tabres,i1,i2,j1,j2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvnb_sponge ***
+      !!--------------------------------------------- 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER  ::   ji, jj, ind1, imax
+      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: vbdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: rotdiff, hdivdiff
+      !!--------------------------------------------- 
+      
+      IF( before ) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = vv_b(ji,jj,Kmm_a)
+            END DO
+         END DO
+      ELSE
+         vbdiff(i1:i2,j1:j2) = (vv_b(i1:i2,j1:j2,Kmm_a) - tabres(i1:i2,j1:j2))*vmask(i1:i2,j1:j2,1)
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = j1+1,j2
+            DO ji = i1,i2   ! vector opt.
+               zbtr = rn_sponge_dyn * r1_Dt * fspt_2d(ji,jj) * r1_ht_0(ji,jj)
+               hdivdiff(ji,jj) = ( e1v(ji,jj  ) * hv(ji,jj  ,Kbb_a) * vbdiff(ji,jj  )  &
+                               &  -e1v(ji,jj-1) * hv(ji,jj-1,Kbb_a) * vbdiff(ji,jj-1)  ) * zbtr
+            END DO
+         END DO
+         DO jj = j1,j2
+            DO ji = i1,i2-1   ! vector opt.
+               zbtr = rn_sponge_dyn * r1_Dt * fspf_2d(ji,jj) * hf_0(ji,jj) 
+               rotdiff(ji,jj) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj) & 
+                              &  -e2v(ji  ,jj) * vbdiff(ji  ,jj)  ) * fmask(ji,jj,1) * zbtr
+            END DO
+         END DO
+         !                                                ! ===============
+         !                                                
+
+         imax = i2 - 1
+         ind1 = jpiglo - ( nn_hls + nbghostcells + 2 )   ! East
+         DO ji = mi0(ind1), mi1(ind1)                
+            imax = MIN(imax,ji)
+         END DO
+         
+         DO jj = j1+1, j2
+            DO ji = i1+1, imax   ! vector opt.
+               IF( .NOT. tabspongedone_u(ji,jj) ) THEN                                                     
+                  zua = - ( rotdiff (ji  ,jj) - rotdiff (ji,jj-1)) * r1_e2u(ji,jj) * r1_hu(ji,jj,Kmm_a)  &
+                      & + ( hdivdiff(ji+1,jj) - hdivdiff(ji,jj  )) * r1_e1u(ji,jj)
+                  uu(ji,jj,:,Krhs_a) = uu(ji,jj,:,Krhs_a) + zua
+               ENDIF
+            END DO
+         END DO
+         !
+         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
+         !
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF( .NOT. tabspongedone_v(ji,jj) ) THEN
+                  zva  =  ( rotdiff (ji,jj  ) - rotdiff (ji-1,jj) ) * r1_e1v(ji,jj) *r1_hv(ji,jj,Kmm_a) &
+                     &  + ( hdivdiff(ji,jj+1) - hdivdiff(ji  ,jj) ) * r1_e2v(ji,jj)                     &
+                     &  - rn_trelax_dyn * r1_Dt * fspv_2d(ji,jj) * vbdiff(ji,jj)
+                  vv(ji,jj,:,Krhs_a) = vv(ji,jj,:,Krhs_a) + zva
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !
+   END SUBROUTINE interpvnb_sponge
+
 
 #else

NEMO/trunk/src/NST/agrif_oce_update.F90

@@ -1 @@
-#undef DECAL_FEEDBACK     /* SEPARATION of INTERFACES */
+#undef DECAL_FEEDBACK    /* SEPARATION of INTERFACES */
 #undef DECAL_FEEDBACK_2D  /* SEPARATION of INTERFACES (Barotropic mode) */
 #undef VOL_REFLUX         /* VOLUME REFLUXING*/
@@ -21 +21 @@
    USE zdf_oce        ! vertical physics: ocean variables 
    USE agrif_oce
+   USE dom_oce
    !
    USE in_out_manager ! I/O manager
@@ -34 +35 @@
 
    PUBLIC   Agrif_Update_Tra, Agrif_Update_Dyn, Agrif_Update_vvl, Agrif_Update_ssh
-   PUBLIC   Update_Scales
+   PUBLIC   Update_Scales, Agrif_Check_parent_bat
 
    !! * Substitutions
@@ -54 +55 @@
       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed()
 
-#if defined key_vertical
-! Effect of this has to be carrefully checked 
-! depending on what the nesting tools ensure for
-! volume conservation:
+      l_vremap                      = ln_vert_remap
+      Agrif_UseSpecialValueInUpdate = .NOT.l_vremap
+      Agrif_SpecialValueFineGrid    = 0._wp
+      ! 
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(ts_update_id, procname=updateTS)
+! near boundary update:
+!      CALL Agrif_Update_Variable(ts_update_id,locupdate=(/0,2/), procname=updateTS)
+# else
+      CALL Agrif_Update_Variable(ts_update_id, locupdate=(/1,0/),procname=updateTS)
+! near boundary update:
+!      CALL Agrif_Update_Variable(ts_update_id,locupdate=(/1,2/), procname=updateTS)
+# endif
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
-#else
-      Agrif_UseSpecialValueInUpdate = .TRUE.
-#endif
-      Agrif_SpecialValueFineGrid    = 0._wp
-      ! 
-# if ! defined DECAL_FEEDBACK
-      CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
-! near boundary update:
-!      CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
-# else
-      CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
-! near boundary update:
-!      CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
-# endif
-      !
-      Agrif_UseSpecialValueInUpdate = .FALSE.
+      l_vremap                      = .FALSE.
       !
       !
@@ -90 +86 @@
       Agrif_UseSpecialValueInUpdate = .FALSE.
       Agrif_SpecialValueFineGrid    = 0._wp
-
-      use_sign_north = .TRUE.
-      sign_north     = -1._wp
-
-      !     
+      l_vremap                      = ln_vert_remap
+      use_sign_north                = .TRUE.
+      sign_north                    = -1._wp     
+!
+# if ! defined DECAL_FEEDBACK_2D
+      CALL Agrif_Update_Variable(unb_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(vnb_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updateV2d)
+# else
+      CALL Agrif_Update_Variable(unb_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/1+nn_shift_bar,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(vnb_update_id,locupdate1=(/1+nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updateV2d)  
+# endif
+      ! 
+      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN
+         ! Update time integrated transports
+#  if ! defined DECAL_FEEDBACK_2D
+         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updateub2b)
+         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updatevb2b)
+#  else
+         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/  nn_shift_bar,-2/),locupdate2=(/1+nn_shift_bar,-2/),procname = updateub2b)
+         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1+nn_shift_bar,-2/),locupdate2=(/  nn_shift_bar,-2/),procname = updatevb2b)
+#  endif
+      END IF
+
 # if ! defined DECAL_FEEDBACK
       CALL Agrif_Update_Variable(un_update_id,procname = updateU)
@@ -108 +122 @@
 !      CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
 # endif
-
-# if ! defined DECAL_FEEDBACK_2D
-      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
-      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
-# else
-      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
-      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
-# endif
-      !
-# if ! defined DECAL_FEEDBACK_2D
-      ! Account for updated thicknesses at boundary edges
-      IF (.NOT.ln_linssh) THEN
-!         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy)
-!         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy)
-      ENDIF
-# endif
-      ! 
-      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN
-         ! Update time integrated transports
-#  if ! defined DECAL_FEEDBACK_2D
-         CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
-         CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
-#  else
-         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
-         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
-#  endif
-      END IF
       !
       use_sign_north = .FALSE.
+      l_vremap = .FALSE.
       !
    END SUBROUTINE Agrif_Update_Dyn
@@ -150 +138 @@
       Agrif_SpecialValueFineGrid = 0._wp
 # if ! defined DECAL_FEEDBACK_2D
-      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
+      CALL Agrif_Update_Variable(sshn_id,locupdate=(/  nn_shift_bar,-2/), procname = updateSSH) 
 # else
-      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
+      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1+nn_shift_bar,-2/),procname = updateSSH)
 # endif
       !
@@ -158 +146 @@
       !
 #  if defined VOL_REFLUX
-      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN
+      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
          use_sign_north = .TRUE.
          sign_north = -1._wp
          ! Refluxing on ssh:
 #  if defined DECAL_FEEDBACK_2D
-         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0, 0/),locupdate2=(/1, 1/),procname = reflux_sshu)
-         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1, 1/),locupdate2=(/0, 0/),procname = reflux_sshv)
+         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/nn_shift_bar,nn_shift_bar/),locupdate2=(/1+nn_shift_bar,1+nn_shift_bar/),procname = reflux_sshu)
+         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1+nn_shift_bar,1+nn_shift_bar/),locupdate2=(/nn_shift_bar,nn_shift_bar/),procname = reflux_sshv)
 #  else
-         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/-1,-1/),locupdate2=(/ 0, 0/),procname = reflux_sshu)
-         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ 0, 0/),locupdate2=(/-1,-1/),procname = reflux_sshv)
+         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/-1+nn_shift_bar,-1+nn_shift_bar/),locupdate2=(/nn_shift_bar, nn_shift_bar/),procname = reflux_sshu)
+         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ nn_shift_bar, nn_shift_bar/),locupdate2=(/-1+nn_shift_bar,-1+nn_shift_bar/),procname = reflux_sshv)
 #  endif
          use_sign_north = .FALSE.
@@ -320 +308 @@
 #endif
 
-#if defined key_vertical
 
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -340 +327 @@
       !
       IF (before) THEN
-!jc_alt
-!         AGRIF_SpecialValue = -999._wp
-         DO jn = n1,n2-1
+         IF ( l_vremap ) THEN
+            DO jn = n1,n2-1
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
+                     END DO
+                  END DO
+               END DO
+            END DO
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
-!jc_alt
-!                     tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) &
-!                                         &  * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp) * 999._wp
-                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
+                     tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
                   END DO
                END DO
             END DO
-         END DO
-         DO jk=k1,k2
+         ELSE
+            DO jn = 1,jpts
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            END DO
+
+         ENDIF
+      ELSE
+         IF ( l_vremap ) THEN
+            tabres_child(:,:,:,:) = 0._wp
+            AGRIF_SpecialValue = 0._wp
             DO jj=j1,j2
                DO ji=i1,i2
-!jc_alt
-!                  tabres(ji,jj,jk,n2) =      tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
-!                                      &   + (tmask(ji,jj,jk) - 1._wp) * 999._wp
-                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
-               END DO
-            END DO
-         END DO
-      ELSE
-         tabres_child(:,:,:,:) = 0._wp
-         AGRIF_SpecialValue = 0._wp
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of child grid
-! jc_alt
-!                  IF (tabres(ji,jj,jk,n2) < -900._wp  ) EXIT
-                  IF (tabres(ji,jj,jk,n2) == 0._wp  ) EXIT
-                  N_in = N_in + 1
-                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
-                  h_in(N_in) = tabres(ji,jj,jk,n2)
+                  N_in = 0
+                  DO jk=k1,k2 !k2 = jpk of child grid
+                     IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp  ) EXIT
+                     N_in = N_in + 1
+                     tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
+                     h_in(N_in) = tabres(ji,jj,jk,n2)
+                  ENDDO
+                  N_out = 0
+                  DO jk=1,jpk ! jpk of parent grid
+                     IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF
+                     N_out = N_out + 1
+                     h_out(N_out) = e3t(ji,jj,jk,Kmm_a) 
+                  ENDDO
+                  IF (N_in*N_out > 0) THEN !Remove this?
+                     CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
+                  ENDIF
                ENDDO
-               N_out = 0
-               DO jk=1,jpk ! jpk of parent grid
-                  IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF
-                  N_out = N_out + 1
-                  h_out(N_out) = e3t(ji,jj,jk,Kmm_a) 
-               ENDDO
-               IF (N_in*N_out > 0) THEN !Remove this?
-                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
-               ENDIF
             ENDDO
-         ENDDO
-
-         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
-            ! Add asselin part
+
+            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
+               ! Add asselin part
+               DO jn = 1,jpts
+                  DO jk = 1, jpkm1
+                     DO jj = j1, j2
+                        DO ji = i1, i2
+                           IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
+                              ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                              ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
+                              ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                              ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
+                           ENDIF
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
             DO jn = 1,jpts
                DO jk = 1, jpkm1
                   DO jj = j1, j2
                      DO ji = i1, i2
-                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
-                           ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
-                           ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
-                           ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
-                           ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
-                        ENDIF
+                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
+                           ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
+                        END IF
                      END DO
                   END DO
                END DO
             END DO
-         ENDIF
-         DO jn = 1,jpts
-            DO jk = 1, jpkm1
-               DO jj = j1, j2
-                  DO ji = i1, i2
-                     IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
-                        ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
-                     END IF
+         ELSE
+            DO jn = 1,jpts
+               tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
+                                            & * tmask(i1:i2,j1:j2,k1:k2)
+            ENDDO
+ 
+            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
+               ! Add asselin part
+               DO jn = 1,jpts
+                  DO jk = k1, k2
+                     DO jj = j1, j2
+                        DO ji = i1, i2
+                           IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
+                              ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                              ztnu = tabres(ji,jj,jk,jn)
+                              ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                              ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
+                           ENDIF
+                        END DO
+                     END DO
                   END DO
                END DO
-            END DO
-         END DO
-         !
+            ENDIF
+            DO jn = 1,jpts
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
+                           ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
+                        END IF
+                     END DO
+                  END DO
+               END DO
+            END DO
+            !
+         ENDIF
          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
             ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kmm_a)
-         ENDIF
+         ENDIF         
       ENDIF
       ! 
    END SUBROUTINE updateTS
 
-# else
-
-   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateT ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji,jj,jk,jn
-      REAL(wp) :: ztb, ztnu, ztno
-      !!---------------------------------------------
-      !
-      IF (before) THEN
-         DO jn = 1,jpts
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-!> jc tmp
-                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
-!                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a)
-!< jc tmp
-                  END DO
-               END DO
-            END DO
-         END DO
-      ELSE
-!> jc tmp
-         DO jn = 1,jpts
-            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
-                                         & * tmask(i1:i2,j1:j2,k1:k2)
-         ENDDO
-!< jc tmp
-         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
-            ! Add asselin part
-            DO jn = 1,jpts
-               DO jk = k1, k2
-                  DO jj = j1, j2
-                     DO ji = i1, i2
-                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
-                           ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
-                           ztnu = tabres(ji,jj,jk,jn)
-                           ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
-                           ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
-                        ENDIF
-                     END DO
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         DO jn = 1,jpts
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
-                        ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
-                     END IF
-                  END DO
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
-            ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm_a)
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE updateTS
-
-# endif
-
-# if defined key_vertical
 
    SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -513 +465 @@
       INTEGER ::   ji, jj, jk
       REAL(wp)::   zrhoy, zub, zunu, zuno
+      REAL(wp), DIMENSION(jpi,jpj) ::   zpgu   ! 2D workspace
 ! VERTICAL REFINEMENT BEGIN
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
       REAL(wp) :: h_in(k1:k2)
       REAL(wp) :: h_out(1:jpk)
-      INTEGER  :: N_in, N_out
-      REAL(wp) :: h_diff, excess, thick
+      INTEGER  :: N_in, N_out, N_in_save, N_out_save
+      REAL(wp) :: zhmin, zd
       REAL(wp) :: tabin(k1:k2)
 ! VERTICAL REFINEMENT END
@@ -525 +478 @@
       IF( before ) THEN
          zrhoy = Agrif_Rhoy()
-!jc_alt
-!         AGRIF_SpecialValue = -999._wp
          DO jk=k1,k2
+            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) & 
+                                     &   * umask(i1:i2,j1:j2,jk) * uu(i1:i2,j1:j2,jk,Kmm_a)  
+         END DO
+
+         IF ( l_vremap ) THEN
+            DO jk=k1,k2
+               tabres(i1:i2,j1:j2,jk,2) = zrhoy * umask(i1:i2,j1:j2,jk) * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a)
+            END DO
+         ENDIF
+
+      ELSE
+
+         tabres_child(:,:,:) = 0._wp
+
+         IF ( l_vremap ) THEN
+
             DO jj=j1,j2
                DO ji=i1,i2
-!jc_alt
-!                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  &
-!                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp
-                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  
-!jc_alt
-!                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)  &
-!                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp
-                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
-               END DO
-            END DO
-         END DO
-      ELSE
-         tabres_child(:,:,:) = 0.
-         AGRIF_SpecialValue = 0._wp
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               h_in(:) = 0._wp
-               tabin(:) = 0._wp
-               DO jk=k1,k2 !k2=jpk of child grid
-!jc_alt
-!                  IF( tabres(ji,jj,jk,2) < -900._wp) EXIT
-                  IF( tabres(ji,jj,jk,2) == 0.) EXIT
-                  N_in = N_in + 1
-                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
-                  h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj)
+                  N_in = 0
+                  h_in(:) = 0._wp
+                  tabin(:) = 0._wp
+                  DO jk=k1,k2 !k2=jpk of child grid
+                     IF( tabres(ji,jj,jk,2)*r1_e2u(ji,jj) <= 1.e-6_wp ) EXIT
+                     N_in = N_in + 1
+                     tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
+                     h_in(N_in) = tabres(ji,jj,jk,2) * r1_e2u(ji,jj)
+                  ENDDO
+                  N_out = 0
+                  DO jk=1,jpk
+                     IF (umask(ji,jj,jk) == 0._wp) EXIT
+                     N_out = N_out + 1
+                     h_out(N_out) = e3u(ji,jj,jk,Kmm_a)
+                  ENDDO
+                  IF (N_in * N_out > 0) THEN
+                     ! Deal with potentially different depths at velocity points:
+                     N_in_save  = N_in
+                     N_out_save = N_out
+                     IF ( ABS(sum(h_out(1:N_out))-sum(h_in(1:N_in))) > 1.e-6_wp ) THEN
+                        zhmin = MIN(sum(h_out(1:N_out)), sum(h_in(1:N_in)))
+                        zd = 0._wp
+                        DO jk=1, N_in_save
+                           IF ( (zd +  h_in(jk)) > zhmin-1.e-6) THEN
+                              N_in = jk
+                              h_in(jk) = zhmin - zd
+                              EXIT 
+                           ENDIF
+                           zd = zd + h_in(jk)
+                        END DO
+                        zd = 0._wp
+                        DO jk=1, N_out_save
+                           IF ( (zd +  h_out(jk)) > zhmin-1.e-6) THEN
+                              N_out = jk
+                              h_out(jk) = zhmin - zd
+                              EXIT 
+                           ENDIF
+                           zd = zd + h_out(jk)
+                        END DO
+                     END IF
+                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+                     IF (N_out < N_out_save) tabres_child(ji,jj,N_out+1:N_out_save) = tabres_child(ji,jj,N_out)
+                  ENDIF
                ENDDO
-               N_out = 0
-               DO jk=1,jpk
-                  IF (umask(ji,jj,jk) == 0) EXIT
-                  N_out = N_out + 1
-                  h_out(N_out) = e3u(ji,jj,jk,Kmm_a)
-               ENDDO
-               IF (N_in * N_out > 0) THEN
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  excess = 0._wp
-                  IF (h_diff < -1.e-4) THEN
-!Even if bathy at T points match it's possible for the U points to be deeper in the child grid. 
-!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell.
-                     DO jk=N_in,1,-1
-                        thick = MIN(-1*h_diff, h_in(jk))
-                        excess = excess + tabin(jk)*thick*e2u(ji,jj)
-                        tabin(jk) = tabin(jk)*(1. - thick/h_in(jk))
-                        h_diff = h_diff + thick
-                        IF ( h_diff == 0) THEN
-                           N_in = jk
-                           h_in(jk) = h_in(jk) - thick
-                           EXIT
-                        ENDIF
-                     ENDDO
-                  ENDIF
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
-                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out))
-               ENDIF
             ENDDO
-         ENDDO
+
+         ELSE
+            DO jk=1,jpk
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) /  e3u(ji,jj,jk,Kmm_a)
+                  END DO
+               END DO
+            END DO
+         ENDIF
          !
          DO jk=1,jpk
@@ -603 +569 @@
          END DO
          !
+         ! Correct now and before transports:
+         DO jj=j1,j2
+            DO ji=i1,i2
+               zpgu(ji,jj) = 0._wp
+               DO jk=1,jpkm1
+                  zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)
+               END DO
+               !
+               DO jk=1,jpkm1              
+                  uu(ji,jj,jk,Kmm_a) = uu(ji,jj,jk,Kmm_a) + &
+                      &  (uu_b(ji,jj,Kmm_a) - zpgu(ji,jj) * r1_hu(ji,jj,Kmm_a)) * umask(ji,jj,jk)           
+               END DO
+               !
+               zpgu(ji,jj) = 0._wp
+               DO jk=1,jpkm1
+                  zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a)
+               END DO
+               !
+               DO jk=1,jpkm1              
+                  uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) + &
+                      &  (uu_b(ji,jj,Kbb_a) - zpgu(ji,jj) * r1_hu(ji,jj,Kbb_a)) * umask(ji,jj,jk)           
+               END DO
+               !
+            END DO
+         END DO
+         !
          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
             uu(i1:i2,j1:j2,1:jpkm1,Kbb_a)  = uu(i1:i2,j1:j2,1:jpkm1,Kmm_a)
@@ -611 +603 @@
    END SUBROUTINE updateu
 
-#else
-
-   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateu ***
-      !!---------------------------------------------
-      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL                                     , INTENT(in   ) :: before
-      !
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: zrhoy, zub, zunu, zuno
-      !!---------------------------------------------
-      ! 
-      IF( before ) THEN
-         zrhoy = Agrif_Rhoy()
-         DO jk = k1, k2
-            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * uu(i1:i2,j1:j2,jk,Kmm_a)
-         END DO
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) 
-                  !
-                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
-                     zub  = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a)  ! fse3t_b prior update should be used
-                     zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a)
-                     zunu = tabres(ji,jj,jk,1)
-                     uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &      
-                                    & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a)
-                  ENDIF
-                  !
-                  uu(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm_a)
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
-            uu(i1:i2,j1:j2,k1:k2,Kbb_a)  = uu(i1:i2,j1:j2,k1:k2,Kmm_a)
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE updateu
-
-# endif
-
-   SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
-      !!---------------------------------------------
-      !!           *** ROUTINE correct_u_bdy ***
+
+   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updatev ***
       !!---------------------------------------------
       INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
       LOGICAL                                     , INTENT(in   ) :: before
-      INTEGER                                     , INTENT(in)    :: nb, ndir
-      !!
-      LOGICAL :: western_side, eastern_side 
-      !
-      INTEGER  :: jj, jk
-      REAL(wp) :: zcor
-      !!---------------------------------------------
-      ! 
-      IF( .NOT.before ) THEN
-         !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         !
-         IF (western_side) THEN
-            DO jj=j1,j2
-               zcor = uu_b(i1-1,jj,Kmm_a) * hu(i1-1,jj,Krhs_a) * r1_hu(i1-1,jj,Kmm_a) - uu_b(i1-1,jj,Kmm_a)
-               uu_b(i1-1,jj,Kmm_a) = uu_b(i1-1,jj,Kmm_a) + zcor
-               DO jk=1,jpkm1
-                  uu(i1-1,jj,jk,Kmm_a) = uu(i1-1,jj,jk,Kmm_a) + zcor * umask(i1-1,jj,jk)
-               END DO 
-            END DO
-         ENDIF
-         !
-         IF (eastern_side) THEN
-            DO jj=j1,j2
-               zcor = uu_b(i2+1,jj,Kmm_a) * hu(i2+1,jj,Krhs_a) * r1_hu(i2+1,jj,Kmm_a) - uu_b(i2+1,jj,Kmm_a)
-               uu_b(i2+1,jj,Kmm_a) = uu_b(i2+1,jj,Kmm_a) + zcor
-               DO jk=1,jpkm1
-                  uu(i2+1,jj,jk,Kmm_a) = uu(i2+1,jj,jk,Kmm_a) + zcor * umask(i2+1,jj,jk)
-               END DO 
-            END DO
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE correct_u_bdy
-
-# if  defined key_vertical
-
-   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updatev ***
-      !!---------------------------------------------
-      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL                                     , INTENT(in   ) :: before
       !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zrhox, zvb, zvnu, zvno
+      REAL(wp), DIMENSION(jpi,jpj) ::   zpgv   ! 2D workspace
 ! VERTICAL REFINEMENT BEGIN
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
       REAL(wp) :: h_in(k1:k2)
       REAL(wp) :: h_out(1:jpk)
-      INTEGER :: N_in, N_out
-      REAL(wp) :: h_diff, excess, thick
+      INTEGER  :: N_in, N_out, N_in_save, N_out_save
+      REAL(wp) :: zhmin, zd
       REAL(wp) :: tabin(k1:k2)
 ! VERTICAL REFINEMENT END
@@ -727 +627 @@
       IF( before ) THEN
          zrhox = Agrif_Rhox()
-!jc_alt
-!         AGRIF_SpecialValue = -999._wp
          DO jk=k1,k2
+            tabres(i1:i2,j1:j2,jk,1) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) & 
+                                     &   * vmask(i1:i2,j1:j2,jk) * vv(i1:i2,j1:j2,jk,Kmm_a)  
+         END DO
+
+         IF ( l_vremap ) THEN
+            DO jk=k1,k2
+               tabres(i1:i2,j1:j2,jk,2) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+            END DO
+         ENDIF
+
+      ELSE
+
+         tabres_child(:,:,:) = 0._wp
+
+         IF ( l_vremap ) THEN
+
             DO jj=j1,j2
                DO ji=i1,i2
-!jc_alt
-!                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) &
-!                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp
-                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) 
-!jc_alt
-!                  tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) &
-!                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp
-                  tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-         tabres_child(:,:,:) = 0.
-         AGRIF_SpecialValue = 0._wp
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2
-!jc_alt
-!                  IF (tabres(ji,jj,jk,2) < -900._wp) EXIT
-                  IF (tabres(ji,jj,jk,2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
-                  h_in(N_in) = tabres(ji,jj,jk,2)/e1v(ji,jj)
+                  N_in = 0
+                  DO jk=k1,k2
+                     IF (tabres(ji,jj,jk,2)* r1_e1v(ji,jj) <= 1.e-6_wp) EXIT
+                     N_in = N_in + 1
+                     tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
+                     h_in(N_in) = tabres(ji,jj,jk,2) * r1_e1v(ji,jj)
+                  ENDDO
+                  N_out = 0
+                  DO jk=1,jpk
+                     IF (vmask(ji,jj,jk) == 0) EXIT
+                     N_out = N_out + 1
+                     h_out(N_out) = e3v(ji,jj,jk,Kmm_a)
+                  ENDDO
+                  IF (N_in * N_out > 0) THEN
+                     ! Deal with potentially different depths at velocity points:
+                     N_in_save  = N_in
+                     N_out_save = N_out
+                     IF ( ABS(sum(h_out(1:N_out))-sum(h_in(1:N_in))) > 1.e-6_wp ) THEN
+                        zhmin = MIN(sum(h_out(1:N_out)), sum(h_in(1:N_in)))
+                        zd = 0._wp
+                        DO jk=1, N_in_save
+                           IF ( (zd +  h_in(jk)) > zhmin-1.e-6) THEN
+                              N_in = jk
+                              h_in(jk) = zhmin - zd
+                              EXIT 
+                           ENDIF
+                           zd = zd + h_in(jk)
+                        END DO
+                        zd = 0._wp
+                        DO jk=1, N_out_save
+                           IF ( (zd +  h_out(jk)) > zhmin-1.e-6) THEN
+                              N_out = jk
+                              h_out(jk) = zhmin - zd
+                              EXIT 
+                           ENDIF
+                           zd = zd + h_out(jk)
+                        END DO
+                     END IF
+                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+                     IF (N_out < N_out_save) tabres_child(ji,jj,N_out+1:N_out_save) = tabres_child(ji,jj,N_out)
+                  ENDIF
                ENDDO
-               N_out = 0
-               DO jk=1,jpk
-                  IF (vmask(ji,jj,jk) == 0) EXIT
-                  N_out = N_out + 1
-                  h_out(N_out) = e3v(ji,jj,jk,Kmm_a)
-               ENDDO
-               IF (N_in * N_out > 0) THEN
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  excess = 0._wp
-                  IF (h_diff < -1.e-4) then
-!Even if bathy at T points match it's possible for the V points to be deeper in the child grid. 
-!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell.
-                     DO jk=N_in,1,-1
-                        thick = MIN(-1*h_diff, h_in(jk))
-                        excess = excess + tabin(jk)*thick*e2u(ji,jj)
-                        tabin(jk) = tabin(jk)*(1. - thick/h_in(jk))
-                        h_diff = h_diff + thick
-                        IF ( h_diff == 0) THEN
-                           N_in = jk
-                           h_in(jk) = h_in(jk) - thick
-                           EXIT
-                        ENDIF
-                     ENDDO
-                  ENDIF
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
-                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out))
-               ENDIF
             ENDDO
-         ENDDO
+
+         ELSE
+            DO jk=1,jpk
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) /  e3v(ji,jj,jk,Kmm_a)
+                  END DO
+               END DO
+            END DO
+         ENDIF
          !
          DO jk=1,jpkm1
@@ -803 +716 @@
          END DO
          !
+         ! Correct now and before transports:
+         DO jj=j1,j2
+            DO ji=i1,i2
+               zpgv(ji,jj) = 0._wp
+               DO jk=1,jpkm1
+                  zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
+               END DO
+               !
+               DO jk=1,jpkm1              
+                  vv(ji,jj,jk,Kmm_a) = vv(ji,jj,jk,Kmm_a) + &
+                      &  (vv_b(ji,jj,Kmm_a) - zpgv(ji,jj) * r1_hv(ji,jj,Kmm_a)) * vmask(ji,jj,jk)           
+               END DO
+               !
+               zpgv(ji,jj) = 0._wp
+               DO jk=1,jpkm1
+                  zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a)
+               END DO
+               !
+               DO jk=1,jpkm1              
+                  vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) + &
+                      &  (vv_b(ji,jj,Kbb_a) - zpgv(ji,jj) * r1_hv(ji,jj,Kbb_a)) * vmask(ji,jj,jk)           
+               END DO
+               !
+            END DO
+         END DO
+         !
          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
             vv(i1:i2,j1:j2,1:jpkm1,Kbb_a)  = vv(i1:i2,j1:j2,1:jpkm1,Kmm_a)
@@ -810 +749 @@
       ! 
    END SUBROUTINE updatev
-
-# else
-
-   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before)
-      !!---------------------------------------------
-      !!           *** ROUTINE updatev ***
-      !!---------------------------------------------
-      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL                                     , INTENT(in   ) :: before
-      !
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: zrhox, zvb, zvnu, zvno
-      !!---------------------------------------------      
-      !
-      IF (before) THEN
-         zrhox = Agrif_Rhox()
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
-               END DO
-            END DO
-         END DO
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj)
-                  !
-                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
-                     zvb  = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
-                     zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a)
-                     zvnu = tabres(ji,jj,jk,1)
-                     vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &      
-                                    & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a)
-                  ENDIF
-                  !
-                  vv(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm_a)
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
-            vv(i1:i2,j1:j2,k1:k2,Kbb_a)  = vv(i1:i2,j1:j2,k1:k2,Kmm_a)
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE updatev
-
-# endif
-
-   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
-      !!---------------------------------------------
-      !!           *** ROUTINE correct_v_bdy ***
-      !!---------------------------------------------
-      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL                                     , INTENT(in   ) :: before
-      INTEGER                                     , INTENT(in)    :: nb, ndir
-      !!
-      LOGICAL :: southern_side, northern_side 
-      !
-      INTEGER  :: ji, jk
-      REAL(wp) :: zcor
-      !!---------------------------------------------
-      ! 
-      IF( .NOT.before ) THEN
-         !
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         IF (southern_side) THEN
-            DO ji=i1,i2
-               zcor = vv_b(ji,j1-1,Kmm_a) * hv(ji,j1-1,Krhs_a) * r1_hv(ji,j1-1,Kmm_a) - vv_b(ji,j1-1,Kmm_a)
-               vv_b(ji,j1-1,Kmm_a) = vv_b(ji,j1-1,Kmm_a) + zcor
-               DO jk=1,jpkm1
-                  vv(ji,j1-1,jk,Kmm_a) = vv(ji,j1-1,jk,Kmm_a) + zcor * vmask(ji,j1-1,jk)
-               END DO 
-            END DO
-         ENDIF
-         !
-         IF (northern_side) THEN
-            DO ji=i1,i2
-               zcor = vv_b(ji,j2+1,Kmm_a) * hv(ji,j2+1,Krhs_a) * r1_hv(ji,j2+1,Kmm_a) - vv_b(ji,j2+1,Kmm_a)
-               vv_b(ji,j2+1,Kmm_a) = vv_b(ji,j2+1,Kmm_a) + zcor
-               DO jk=1,jpkm1
-                  vv(ji,j2+1,jk,Kmm_a) = vv(ji,j2+1,jk,Kmm_a) + zcor * vmask(ji,j2+1,jk)
-               END DO 
-            END DO
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE correct_v_bdy
 
 
@@ -935 +778 @@
                tabres(ji,jj) =  tabres(ji,jj) * r1_e2u(ji,jj)  
                !    
-               ! Update "now" 3d velocities:
-               zpgu(ji,jj) = 0._wp
-               DO jk=1,jpkm1
-                  zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)
-               END DO
-               !
-               zcorr = (tabres(ji,jj) - zpgu(ji,jj)) * r1_hu(ji,jj,Kmm_a)
-               DO jk=1,jpkm1              
-                  uu(ji,jj,jk,Kmm_a) = uu(ji,jj,jk,Kmm_a) + zcorr * umask(ji,jj,jk)           
-               END DO
-               !
                ! Update barotropic velocities:
                IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
@@ -955 +787 @@
                uu_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hu(ji,jj,Kmm_a) * umask(ji,jj,1)
                !       
-               ! Correct "before" velocities to hold correct bt component:
-               zpgu(ji,jj) = 0.e0
-               DO jk=1,jpkm1
-                  zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a)
-               END DO
-               !
-               zcorr = uu_b(ji,jj,Kbb_a) - zpgu(ji,jj) * r1_hu(ji,jj,Kbb_a)
-               DO jk=1,jpkm1              
-                  uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) + zcorr * umask(ji,jj,jk)           
-               END DO
-               !
             END DO
          END DO
@@ -1002 +823 @@
             DO ji=i1,i2
                tabres(ji,jj) =  tabres(ji,jj) * r1_e1v(ji,jj)  
-               !    
-               ! Update "now" 3d velocities:
-               zpgv(ji,jj) = 0.e0
-               DO jk=1,jpkm1
-                  zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
-               END DO
-               !
-               zcorr = (tabres(ji,jj) - zpgv(ji,jj)) * r1_hv(ji,jj,Kmm_a)
-               DO jk=1,jpkm1              
-                  vv(ji,jj,jk,Kmm_a) = vv(ji,jj,jk,Kmm_a) + zcorr * vmask(ji,jj,jk)           
-               END DO
-               !
                ! Update barotropic velocities:
                IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
@@ -1023 +832 @@
                vv_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hv(ji,jj,Kmm_a) * vmask(ji,jj,1)
                !       
-               ! Correct "before" velocities to hold correct bt component:
-               zpgv(ji,jj) = 0.e0
-               DO jk=1,jpkm1
-                  zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a)
-               END DO
-               !
-               zcorr = vv_b(ji,jj,Kbb_a) - zpgv(ji,jj) * r1_hv(ji,jj,Kbb_a)
-               DO jk=1,jpkm1              
-                  vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) + zcorr * vmask(ji,jj,jk)           
-               END DO
-               !
             END DO
          END DO
@@ -1120 +918 @@
                ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * zcor 
                ! Update corrective fluxes:
-               un_bf(ji,jj)  = un_bf(ji,jj) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) un_bf(ji,jj)  = un_bf(ji,jj) + zcor
                ! Update half step back fluxes:
                ub2_b(ji,jj) = tabres(ji,jj)
@@ -1208 +1006 @@
                vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * zcor 
                ! Update corrective fluxes:
-               vn_bf(ji,jj)  = vn_bf(ji,jj) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler)))  vn_bf(ji,jj)  = vn_bf(ji,jj) + zcor
                ! Update half step back fluxes:
                vb2_b(ji,jj) = tabres(ji,jj)
@@ -1479 +1277 @@
 #endif
 
+   SUBROUTINE Agrif_Check_parent_bat( )
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Check_parent_bat ***
+      !!----------------------------------------------------------------------
+      ! 
+      IF (( .NOT.ln_agrif_2way ).OR.(.NOT.ln_chk_bathy).OR.(Agrif_Root())) RETURN
+      !
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      !
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) 'AGRIF: Check parent volume at Level:', Agrif_Level()
+      !
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(batupd_id,procname = update_bat)
+# else
+      CALL Agrif_Update_Variable(batupd_id,locupdate=(/1,0/),procname = update_bat)
+# endif
+      !
+      kindic_agr = Agrif_Parent(kindic_agr)
+      CALL mpp_sum( 'Agrif_Check_parent_bat', kindic_agr )
+
+      IF( kindic_agr /= 0 ) THEN
+         CALL ctl_stop('==> Averaged Bathymetry does not match parent volume') 
+      ELSE
+         IF(lwp) WRITE(numout,*) '==> Averaged Bathymetry matches parent ' 
+         IF(lwp) WRITE(numout,*) ''
+      ENDIF
+      !
+   END SUBROUTINE Agrif_Check_parent_bat
+
+   SUBROUTINE update_bat(ptab, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE update_bat ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ptab
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      LOGICAL, INTENT(in) :: before
+      INTEGER :: ji, jj
+      !
+      !!---------------------------------------------
+      !
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+      ELSE
+         kindic_agr = 0
+         !
+         DO jj=j1,j2
+            DO ji=i1,i2
+               IF ( (ssmask(ji,jj).NE.0._wp).AND.&
+               & (ABS(ptab(ji,jj)-ht_0(ji,jj)).GE.1.e-6) ) THEN 
+                  kindic_agr = kindic_agr + 1 
+               ENDIF
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE update_bat
+
 #else
    !!----------------------------------------------------------------------

NEMO/trunk/src/NST/agrif_top_interp.F90

@@ -43 +43 @@
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      l_vremap              = ln_vert_remap
       !
       CALL Agrif_Bc_variable( trn_id, procname=interptrn )
+      !
       Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
       !
    END SUBROUTINE Agrif_trc
@@ -57 +60 @@
       LOGICAL                                     , INTENT(in   ) ::   before
       !
-      INTEGER  ::   ji, jj, jk, jn, ibdy, jbdy   ! dummy loop indices
-      INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out
-      REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7
-
+      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices
+      INTEGER  ::   N_in, N_out
+      INTEGER  :: item
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child
-      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
-      REAL(wp), DIMENSION(k1:k2) :: h_in
-      REAL(wp), DIMENSION(1:jpk) :: h_out
-      !!----------------------------------------------------------------------
-
-      IF( before ) THEN         
+      REAL(wp) :: zhtot, zwgt
+      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin, tabin_i
+      REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i
+      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
+      !!----------------------------------------------------------------------
+
+      IF( before ) THEN
+
+         item = Kmm_a
+         IF( l_ini_child )   Kmm_a = Kbb_a  
+
          DO jn = 1,jptra
             DO jk=k1,k2
@@ -77 +83 @@
               END DO
            END DO
-        END DO
-
-# if defined key_vertical
-        DO jk=k1,k2
-           DO jj=j1,j2
-              DO ji=i1,i2
-                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
-              END DO
-           END DO
-        END DO
-# endif
+         END DO
+
+         IF( l_vremap .OR. l_ini_child .OR. ln_zps ) THEN
+            ! Fill cell depths (i.e. gdept) to be interpolated
+            ! Warning: these are masked, hence extrapolated prior interpolation.
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a)
+                  DO jk=k1+1,k2
+                     ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * &
+                        & ( ptab(ji,jj,jk-1,jptra+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) )
+                  END DO
+               END DO
+            END DO
+
+            ! Save ssh at last level:
+            IF (.NOT.ln_linssh) THEN
+               ptab(i1:i2,j1:j2,k2,jptra+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 
+            END IF      
+         ENDIF
+         Kmm_a = item
+
       ELSE 
-
-# if defined key_vertical
-         DO jj=j1,j2
-            DO ji=i1,i2
-               ptab_child(ji,jj,:) = 0._wp
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of parent grid
-                  IF (ptab(ji,jj,jk,n2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1)
-                  h_in(N_in) = ptab(ji,jj,jk,n2)
+         item = Krhs_a
+         IF( l_ini_child )   Krhs_a = Kbb_a  
+
+         IF( l_vremap .OR. l_ini_child ) THEN
+            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp 
+               
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tr(ji,jj,:,:,Krhs_a) = 0.  
+                  !
+                  ! Build vertical grids:
+                  N_in = mbkt_parent(ji,jj)
+                  ! Input grid (account for partial cells if any):
+                  DO jk=1,N_in
+                     z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
+                     tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra)
+                  END DO
+                  
+                  ! Intermediate grid:
+                  IF ( l_vremap ) THEN
+                     DO jk = 1, N_in
+                        h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 
+                          &       (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
+                     END DO
+                     z_in_i(1) = 0.5_wp * h_in_i(1)
+                     DO jk=2,N_in
+                        z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+                     END DO
+                     z_in_i(1:N_in) = z_in_i(1:N_in)  - ptab(ji,jj,k2,n2)
+                  ENDIF
+
+                  ! Output (Child) grid:
+                  N_out = mbkt(ji,jj)
+                  DO jk=1,N_out
+                     h_out(jk) = e3t(ji,jj,jk,Krhs_a)
+                  END DO
+                  z_out(1) = 0.5_wp * h_out(1)
+                  DO jk=2,N_out
+                     z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+                  END DO
+                  IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out)  - ssh(ji,jj,Krhs_a)               
+
+                  IF (N_in*N_out > 0) THEN
+                     IF( l_ini_child ) THEN
+                        CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a),          &
+                                      &   z_out(1:N_out),N_in,N_out,jptra)  
+                     ELSE  
+                        CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra),                     &
+                                     &   z_in_i(1:N_in),N_in,N_in,jptra)
+                        CALL reconstructandremap(tabin_i(1:N_in,1:jptra),h_in_i(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), &
+                                      &   h_out(1:N_out),N_in,N_out,jptra)   
+                     ENDIF
+                  ENDIF
                END DO
-               N_out = 0
-               DO jk=1,jpk ! jpk of child grid
-                  IF (tmask(ji,jj,jk) == 0) EXIT 
-                  N_out = N_out + 1
-                  h_out(jk) = e3t(ji,jj,jk,Krhs_a)
-               ENDDO
-               IF (N_in > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,ptab_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
-               ENDIF
-            ENDDO
-         ENDDO
-# else
-         ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra)
-# endif
-         !
-         DO jn=1, jptra
-            tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
-         END DO
+            END DO
+            Krhs_a = item
+ 
+         ELSE
+
+            IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells 
+                                             ! linear vertical interpolation
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     !
+                     N_in  = mbkt(ji,jj)
+                     N_out = mbkt(ji,jj)
+                     z_in(1) = ptab(ji,jj,1,n2)
+                     tabin(1,1:jptra) = ptab(ji,jj,1,1:jptra)
+                     DO jk=2, N_in
+                        z_in(jk) = ptab(ji,jj,jk,n2)
+                        tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra)
+                     END DO
+                     IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
+                     z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a)
+                     DO jk=2, N_out
+                        z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a))
+                     END DO
+                     IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
+                     CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jptra), &
+                                   &   z_out(1:N_out),N_in,N_out,jptra)  
+                  END DO
+               END DO
+
+            ENDIF
+
+            DO jn=1, jptra
+                tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
+            END DO
+         ENDIF
+
       ENDIF
       !

NEMO/trunk/src/NST/agrif_top_sponge.F90

@@ -45 +45 @@
       !
 #if defined SPONGE_TOP
-!! Assume persistence 
+      !! Assume persistence:
       zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
-      CALL Agrif_sponge
+
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      l_vremap              = ln_vert_remap
       tabspongedone_trn     = .FALSE.
+      !
       CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=zcoef, procname=interptrn_sponge )
+      !
       Agrif_UseSpecialValue = .FALSE.
+      l_vremap              = .FALSE.
 #endif
       !
@@ -58 +62 @@
 
 
-   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!----------------------------------------------------------------------
-      !!                   *** ROUTINE interptrn_sponge ***
+   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE interptrn_sponge ***
       !!----------------------------------------------------------------------
       INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
@@ -67 +71 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zabe1, zabe2, ztrelax
-      REAL(wp), DIMENSION(i1:i2,j1:j2)               ::   ztu, ztv
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) ::   trbdiff
+      INTEGER  ::   iku, ikv
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr, zhtot
+      REAL(wp), DIMENSION(i1-1:i2,j1-1:j2,jpk) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::trbdiff
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,1:jptra) ::tabres_child
-      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
-      REAL(wp), DIMENSION(k1:k2) :: h_in
-      REAL(wp), DIMENSION(1:jpk) :: h_out
+      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child
+      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin, tabin_i
+      REAL(wp), DIMENSION(k1:k2) :: z_in, z_in_i, h_in_i
+      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
       INTEGER :: N_in, N_out
-      REAL(wp) :: h_diff
       !!----------------------------------------------------------------------
       !
@@ -90 +94 @@
          END DO
 
-# if defined key_vertical
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
-               END DO
-            END DO
-         END DO
-# endif
-      ELSE      
-# if defined key_vertical
-         tabres_child(:,:,:,:) = 0.
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of parent grid
-                  IF (tabres(ji,jj,jk,n2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
-                  h_in(N_in) = tabres(ji,jj,jk,n2)
-               END DO
-               N_out = 0
-               DO jk=1,jpk ! jpk of child grid
-                  IF (tmask(ji,jj,jk) == 0) EXIT 
-                  N_out = N_out + 1
-                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
-               ENDDO
-               IF (N_in > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,tabres_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
+         IF ( l_vremap.OR.ln_zps ) THEN
+
+            ! Fill cell depths (i.e. gdept) to be interpolated
+            ! Warning: these are masked, hence extrapolated prior interpolation.
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kbb_a)
+                  DO jk=k1+1,k2
+                     tabres(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * &
+                        & ( tabres(ji,jj,jk-1,jptra+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a)+e3t(ji,jj,jk,Kbb_a)) )
+                  END DO
+               END DO
+            END DO
+
+            ! Save ssh at last level:
+            IF ( .NOT.ln_linssh ) THEN
+               tabres(i1:i2,j1:j2,k2,jptra+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1) 
+            END IF  
+    
+         END IF
+
+      ELSE 
+         !
+         IF ( l_vremap ) THEN
+
+            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+
+                  tabres_child(ji,jj,:,:) = 0._wp 
+                  ! Build vertical grids:
+                  N_in = mbkt_parent(ji,jj)
+                  ! Input grid (account for partial cells if any):
+                  DO jk=1,N_in
+                     z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2)
+                     tabin(jk,1:jptra) = tabres(ji,jj,jk,1:jptra)
+                  END DO
+                  
+                  ! Intermediate grid:
+                  DO jk = 1, N_in
+                     h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 
+                       &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
+                  END DO
+                  z_in_i(1) = 0.5_wp * h_in_i(1)
+                  DO jk=2,N_in
+                     z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+                  END DO
+                  z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2)
+
+                  ! Output (Child) grid:
+                  N_out = mbkt(ji,jj)
+                  DO jk=1,N_out
+                     h_out(jk) = e3t(ji,jj,jk,Kbb_a)
+                  END DO
+                  z_out(1) = 0.5_wp * h_out(1)
+                  DO jk=2,N_out
+                     z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+                  END DO
+                  IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out)  - ssh(ji,jj,Kbb_a)
+
+                  ! Account for small differences in the free-surface
+                  IF ( sum(h_out(1:N_out)) > sum(h_in_i(1:N_in) )) THEN
+                     h_out(1) = h_out(1)  - ( sum(h_out(1:N_out))-sum(h_in_i(1:N_in)) )
+                  ELSE
+                     h_in_i(1)= h_in_i(1) - ( sum(h_in_i(1:N_in))-sum(h_out(1:N_out)) )
+                  END IF
+                  IF (N_in*N_out > 0) THEN
+                     CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra),z_in_i(1:N_in),N_in,N_in,jptra)
+                     CALL reconstructandremap(tabin_i(1:N_in,1:jptra),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
+!                     CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),z_out(1:N_in),N_in,N_out,jptra)  
+                  ENDIF
+               END DO
+            END DO
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  DO jk=1,jpkm1
+                     trbdiff(ji,jj,jk,1:jptra) = (tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+         ELSE
+
+            IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells
+
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     !
+                     N_in  = mbkt(ji,jj) 
+                     N_out = mbkt(ji,jj) 
+                     z_in(1) = tabres(ji,jj,1,n2)
+                     tabin(1,1:jptra) = tabres(ji,jj,1,1:jptra)
+                     DO jk=2, N_in
+                        z_in(jk) = tabres(ji,jj,jk,n2)
+                        tabin(jk,1:jptra) = tabres(ji,jj,jk,1:jptra)
+                     END DO 
+                     IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - tabres(ji,jj,k2,n2)
+
+                     z_out(1) = 0.5_wp * e3t(ji,jj,1,Kbb_a)
+                     DO jk=2, N_out
+                        z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk,Kbb_a)) 
+                     END DO 
+                     IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
+
+                     CALL remap_linear(tabin(1:N_in,1:jptra), z_in(1:N_in), tabres(ji,jj,1:N_out,1:jptra), &
+                                         &   z_out(1:N_out), N_in, N_out, jptra)
+                  END DO
+               END DO
+            ENDIF
+
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  DO jk=1,jpkm1
+                     trbdiff(ji,jj,jk,1:jptra) = (tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra))*tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+         END IF
+
+         DO jn = 1, jptra            
+            DO jk = 1, jpkm1
+               ztu(i1-1:i2,j1-1:j2,jk) = 0._wp
+               DO jj = j1,j2
+                  DO ji = i1,i2-1
+                     zabe1 = rn_sponge_tra * r1_Dt * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
+                     ztu(ji,jj,jk) = zabe1 * fspu(ji,jj) * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
+                  END DO
+               END DO
+               ztv(i1-1:i2,j1-1:j2,jk) = 0._wp
+               DO ji = i1,i2
+                  DO jj = j1,j2-1
+                     zabe2 = rn_sponge_tra * r1_Dt * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
+                     ztv(ji,jj,jk) = zabe2 * fspv(ji,jj) * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  END DO
+               END DO
+               !
+               IF( ln_zps ) THEN      ! set gradient at partial step level
+                  DO jj = j1,j2
+                     DO ji = i1,i2
+                        ! last level
+                        iku = mbku(ji,jj)
+                        ikv = mbkv(ji,jj)
+                        IF( iku == jk )   ztu(ji,jj,jk) = 0._wp
+                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp
+                     END DO
+                  END DO
                ENDIF
-            ENDDO
-         ENDDO
-# endif
-
-         DO jj=j1,j2
-            DO ji=i1,i2
-               DO jk=1,jpkm1
-# if defined key_vertical
-                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)
-# else
-                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)
-# endif
-               ENDDO
-            ENDDO
-         ENDDO
-
-         !* set relaxation time scale
-         IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rn_Dt )
-         ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rn_Dt )
-         ENDIF
-
-         DO jn = 1, jptra
+            END DO
+            !
+! JC: there is something wrong with the Laplacian in corners
             DO jk = 1, jpkm1
-               DO jj = j1,j2-1
-                  DO ji = i1,i2-1
-                     zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk)
-                     zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
-                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                  END DO
-               END DO
-               !
-               DO jj = j1+1,j2-1
-                  DO ji = i1+1,i2-1
-                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
-                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
-                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
-                           &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)  &
-                           &                                - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn)
+               DO jj = j1,j2
+                  DO ji = i1,i2
+                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
+                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)
+                        ! horizontal diffusive trends
+                        ztra = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
+                          &           + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
+                          &   - rn_trelax_tra * r1_Dt * fspt(ji,jj) * trbdiff(ji,jj,jk,jn)
+                        ! add it to the general tracer trends
+                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + ztra
                      ENDIF
                   END DO
                END DO
+
             END DO
             !
          END DO
          !
-         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+         tabspongedone_trn(i1:i2,j1:j2) = .TRUE.
+         !
       ENDIF
-      !                 
+      !
    END SUBROUTINE interptrn_sponge
 

NEMO/trunk/src/NST/agrif_top_update.F90

@@ -40 +40 @@
       IF (Agrif_Root()) RETURN 
       !
-      Agrif_UseSpecialValueInUpdate = .TRUE.
+      l_vremap                      = ln_vert_remap
+      Agrif_UseSpecialValueInUpdate = .NOT.l_vremap
       Agrif_SpecialValueFineGrid    = 0._wp
+
       ! 
 # if ! defined DECAL_FEEDBACK
@@ -52 +54 @@
       !
       Agrif_UseSpecialValueInUpdate = .FALSE.
+      l_vremap                      = .FALSE.
       !
    END SUBROUTINE Agrif_Update_Trc
 
-#ifdef key_vertical
    SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateT ***
-      !!---------------------------------------------
+
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
@@ -72 +72 @@
       REAL(wp) :: tabin(k1:k2,1:jptra)
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: tabres_child
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
-         AGRIF_SpecialValue = -999._wp
-         DO jn = n1,n2-1
+         IF ( l_vremap ) THEN
+            DO jn = n1,n2-1
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
+                     END DO
+                  END DO
+               END DO
+            END DO
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = (tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) &
-                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp
-                  END DO
-               END DO
-            END DO
-         END DO
-         DO jk=k1,k2
+                     tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
+                  END DO
+               END DO
+            END DO
+         ELSE
+            DO jn = 1,jptra
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            END DO
+
+         ENDIF
+      ELSE
+         IF ( l_vremap ) THEN
+            tabres_child(:,:,:,:) = 0._wp
+            AGRIF_SpecialValue = 0._wp
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
-                                           + (tmask(ji,jj,jk)-1)*999._wp
-               END DO
-            END DO
-         END DO
-      ELSE
-         tabres_child(:,:,:,:) = 0.
-         AGRIF_SpecialValue = 0._wp
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of child grid
-                  IF (tabres(ji,jj,jk,n2) == 0  ) EXIT
-                  N_in = N_in + 1
-                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
-                  h_in(N_in) = tabres(ji,jj,jk,n2)
+                  N_in = 0
+                  DO jk=k1,k2 !k2 = jpk of child grid
+                     IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp  ) EXIT
+                     N_in = N_in + 1
+                     tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
+                     h_in(N_in) = tabres(ji,jj,jk,n2)
+                  ENDDO
+                  N_out = 0
+                  DO jk=1,jpk ! jpk of parent grid
+                     IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF
+                     N_out = N_out + 1
+                     h_out(N_out) = e3t(ji,jj,jk,Kmm_a)
+                  ENDDO
+                  IF (N_in*N_out > 0) THEN !Remove this?
+                     CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
+                  ENDIF
                ENDDO
-               N_out = 0
-               DO jk=1,jpk ! jpk of parent grid
-                  IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF
-                  N_out = N_out + 1
-                  h_out(N_out) = e3t(ji,jj,jk,Kmm_a) !Parent grid scale factors. Could multiply by e1e2t here instead of division above
-               ENDDO
-               IF (N_in > 0) THEN !Remove this?
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  IF (h_diff < -1.e-4) THEN
-                     print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out))
-                     print *,h_in(1:N_in)
-                     print *,h_out(1:N_out)
-                     STOP
-                  ENDIF
-                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
-               ENDIF
             ENDDO
-         ENDDO
-         !
-         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
-            ! Add asselin part
-            DO jn = 1,jptra
-               DO jk=1,jpkm1
+
+            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
+               ! Add asselin part
+               DO jn = 1,jptra
+                  DO jk = 1, jpkm1
+                     DO jj = j1, j2
+                        DO ji = i1, i2
+                           IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
+                              ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                              ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
+                              ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                              tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &
+                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
+                           ENDIF
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            DO jn = 1,jptra
+               DO jk = 1, jpkm1
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
+                           tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
+                        END IF
+                     END DO
+                  END DO
+               END DO
+            END DO
+         ELSE
+            DO jn = 1,jptra
+               tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
+                                            & * tmask(i1:i2,j1:j2,k1:k2)
+            ENDDO
+            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
+               ! Add asselin part
+               DO jn = 1,jptra
+                  DO jk = k1, k2
+                     DO jj = j1, j2
+                        DO ji = i1, i2
+                           IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
+                              ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                              ztnu = tabres(ji,jj,jk,jn)
+                              ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                              tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &
+                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
+                           ENDIF
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            DO jn = 1,jptra
+               DO jk=k1,k2
                   DO jj=j1,j2
                      DO ji=i1,i2
-                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN
-                           ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
-                           ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
-                           ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
-                           tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
-                        ENDIF
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
+                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
+                           tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
+                        END IF
+                     END DO
+                  END DO
+               END DO
+            END DO
+            !
          ENDIF
-         DO jn = 1,jptra
-            DO jk=1,jpkm1
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
-                     END IF
-                  END DO
-               END DO
-            END DO
-         END DO
-         !
          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
             tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kbb_a)  = tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kmm_a)
          ENDIF
-         !
-
       ENDIF
-      ! 
+      !
    END SUBROUTINE updateTRC
-
-
-#else
-   SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
-      !!----------------------------------------------------------------------
-      !!                      *** ROUTINE updateTRC ***
-      !!----------------------------------------------------------------------
-      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
-      LOGICAL                                    , INTENT(in   ) ::   before
-      !!
-      INTEGER :: ji,jj,jk,jn
-      REAL(wp) :: ztb, ztnu, ztno
-      !!----------------------------------------------------------------------
-      !
-      !
-      IF (before) THEN
-         DO jn = n1,n2
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-!> jc tmp
-                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
-!                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a)
-!< jc tmp
-                  END DO
-               END DO
-            END DO
-         END DO
-      ELSE
-!> jc tmp
-         DO jn = n1,n2
-            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
-                                         & * tmask(i1:i2,j1:j2,k1:k2)
-         ENDDO
-!< jc tmp
-         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
-            ! Add asselin part
-            DO jn = n1,n2
-               DO jk=k1,k2
-                  DO jj=j1,j2
-                     DO ji=i1,i2
-                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                           ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
-                           ztnu = tabres(ji,jj,jk,jn)
-                           ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
-                           tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
-                        ENDIF
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-         DO jn = n1,n2
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
-                     END IF
-                  END DO
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
-            tr(i1:i2,j1:j2,k1:k2,n1:n2,Kbb_a)  = tr(i1:i2,j1:j2,k1:k2,n1:n2,Kmm_a)
-         ENDIF
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE updateTRC
-#endif
 
 #else

NEMO/trunk/src/NST/agrif_user.F90

@@ -1 +1 @@
 #undef UPD_HIGH   /* MIX HIGH UPDATE */
+#define DIV_CONS   /* DIVERGENCE CONS */
 #if defined key_agrif
    !! * Substitutions
@@ -42 +43 @@
 
    
-   SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa )
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_istate ***
-      !!----------------------------------------------------------------------
-      USE domvvl
-      USE domain
-      USE par_oce
-      USE agrif_oce
-      USE agrif_oce_interp
-      USE oce
-      USE lib_mpp
-      USE lbclnk
-      !
-      IMPLICIT NONE
-      !
-      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa
-      INTEGER :: jn
-      !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent'
-      IF(lwp) WRITE(numout,*) ' '
-
-      l_ini_child           = .TRUE.
-      Agrif_SpecialValue    = 0.0_wp
-      Agrif_UseSpecialValue = .TRUE.
-      uu(:,:,:,:) = 0.0_wp   ;   vv(:,:,:,:) = 0.0_wp   ;   ts(:,:,:,:,:) = 0.0_wp
-       
-      Krhs_a = Kbb   ;   Kmm_a = Kbb
-
-      ! Brutal fix to pas 1x1 refinment. 
-  !    IF(Agrif_Irhox() == 1) THEN
-  !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts)
-  !    ELSE
-      CALL Agrif_Init_Variable(tsini_id, procname=interptsn)
-
-  !    ENDIF
-! just for VORTEX because Parent velocities can actually be exactly zero
-!      Agrif_UseSpecialValue = .FALSE.
-      Agrif_UseSpecialValue = ln_spc_dyn
-      use_sign_north = .TRUE.
-      sign_north = -1.
-      CALL Agrif_Init_Variable(uini_id , procname=interpun )
-      CALL Agrif_Init_Variable(vini_id , procname=interpvn )
-      use_sign_north = .FALSE.
-
-      Agrif_UseSpecialValue = .FALSE.
-      l_ini_child           = .FALSE.
-
-      Krhs_a = Kaa   ;   Kmm_a = Kmm
-
-      DO jn = 1, jpts
-         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:)
-      END DO
-      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)     
-      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 
-
-
-      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp )
-      CALL lbc_lnk(       'agrif_istate', ts(:,:,:,:,Kbb), 'T',  1.0_wp )
-
-   END SUBROUTINE Agrif_Istate
-
-   
    SUBROUTINE agrif_declare_var_ini
       !!----------------------------------------------------------------------
@@ -118 +56 @@
       IMPLICIT NONE
       !
-      INTEGER :: ind1, ind2, ind3
+      INTEGER :: ind1, ind2, ind3, imaxrho
       INTEGER :: its
       External :: nemo_mapping
@@ -134 +72 @@
       ENDIF
 
+      IF ( .NOT. lk_north ) THEN
+         CALL Agrif_Set_DistantCommonBorderY(.TRUE.)
+      ENDIF
+
       ! 1. Declaration of the type of variable which have to be interpolated
       !---------------------------------------------------------------------
-      ind1 =              nbghostcells
+      ind1 =              nbghostcells 
       ind2 = nn_hls + 2 + nbghostcells_x
       ind3 = nn_hls + 2 + nbghostcells_y_s
-
-      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),   e3t_id)
-      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),  mbkt_id)
-      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   ht0_id)
-
-      CALL agrif_declare_variable((/1,2    /),(/ind2-1,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e1u_id)
-      CALL agrif_declare_variable((/2,1    /),(/ind2  ,ind3-1    /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e2v_id)
+      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
+
+      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),        e3t_id)
+      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),e3t0_interp_id)
+      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),       mbkt_id)
+      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),        ht0_id)
    
       ! Initial or restart velues
@@ -154 +95 @@
       CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),sshini_id)
       ! 
+      ! Update location
+      CALL agrif_declare_variable((/2,2/),(/ind2  ,ind3  /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id)
      
       ! 2. Type of interpolation
       !-------------------------
-      CALL Agrif_Set_bcinterp(   e3t_id,interp =AGRIF_constant)
-
-      CALL Agrif_Set_bcinterp(  mbkt_id,interp =AGRIF_constant)
-      CALL Agrif_Set_interp  (  mbkt_id,interp =AGRIF_constant)
-      CALL Agrif_Set_bcinterp(   ht0_id,interp =AGRIF_constant)
-      CALL Agrif_Set_interp  (   ht0_id,interp =AGRIF_constant)
-
-      CALL Agrif_Set_bcinterp(   e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm    )
-      CALL Agrif_Set_bcinterp(   e2v_id,interp1=AGRIF_ppm   , interp2=Agrif_linear )
+      CALL Agrif_Set_bcinterp(        e3t_id,interp =AGRIF_constant)
+      CALL Agrif_Set_bcinterp(e3t0_interp_id,interp =AGRIF_linear  )
+      CALL Agrif_Set_interp  (e3t0_interp_id,interp =AGRIF_linear  )
+      CALL Agrif_Set_bcinterp(       mbkt_id,interp =AGRIF_constant)
+      CALL Agrif_Set_interp  (       mbkt_id,interp =AGRIF_constant)
+      CALL Agrif_Set_bcinterp(        ht0_id,interp =AGRIF_constant)
+      CALL Agrif_Set_interp  (        ht0_id,interp =AGRIF_constant)
 
       ! Initial fields
@@ -179 +120 @@
        ! 3. Location of interpolation
       !-----------------------------
-!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )  
+!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*imaxrho,ind1-1/) )  
 ! JC: check near the boundary only until matching in sponge has been sorted out:
       CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) )  
@@ -185 +126 @@
       ! extend the interpolation zone by 1 more point than necessary:
       ! RB check here
-      CALL Agrif_Set_bc(   mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
-      CALL Agrif_Set_bc(    ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
-      
-      CALL Agrif_Set_bc(    e1u_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc(    e2v_id, (/0,ind1-1/) )  
-
-      CALL Agrif_Set_bc(  tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
-      CALL Agrif_Set_bc(   uini_id, (/0,ind1-1/) ) 
-      CALL Agrif_Set_bc(   vini_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
+      CALL Agrif_Set_bc(        mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
+      CALL Agrif_Set_bc(         ht0_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
+      CALL Agrif_Set_bc(       tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
+      CALL Agrif_Set_bc(        uini_id, (/0,ind1-1/) ) 
+      CALL Agrif_Set_bc(        vini_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc(      sshini_id, (/0,ind1-1/) )
 
       ! 4. Update type
       !--------------- 
 # if defined UPD_HIGH
-      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting)
-      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average       )
+      CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting)
 #else
-      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy          , update2=Agrif_Update_Average       )
-      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Copy          )
-#endif
-      
+      CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average)
+#endif      
+
    !   CALL Agrif_Set_ExternalMapping(nemo_mapping)
       !
@@ -211 +147 @@
 
 
-   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
+   SUBROUTINE Agrif_Init_Domain
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_Init_Domain ***
@@ -231 +167 @@
       IMPLICIT NONE
       !
-      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa
       !
       LOGICAL :: check_namelist
@@ -237 +172 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
       INTEGER :: ji, jj, jk
+      INTEGER :: jpk_parent, ierr
       !!----------------------------------------------------------------------
     
@@ -249 +185 @@
       mbkt_parent(:,:) = 0
       !
-  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
-  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
+!     CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
+!     CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
       CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
       CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
@@ -263 +199 @@
       IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN 
          DO_2D( 1, 0, 1, 0 )
-            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
-            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
+            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) * ssumask(ji,jj)
+            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) * ssvmask(ji,jj)
          END_2D
       ELSE
@@ -277 +213 @@
          zk(ji,jj) = REAL( mbku_parent(ji,jj), wp )
       END_2D
-      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp )
+      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp )
       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
       DO_2D( 0, 0, 0, 0 )
          zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp )
       END_2D
-      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp )
-      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )   
-
-      IF ( ln_init_chfrpar ) THEN 
-         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh)
-         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. )
-#if ! defined key_qco
-         DO jk = 1, jpk
-               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) &
-                        &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )
-         END DO
-#endif
+      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp )
+      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )  
+      !
+      ! Build "intermediate" parent vertical grid on child domain
+      IF ( ln_vert_remap ) THEN
+
+         jpk_parent = Agrif_parent( jpk )
+         ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), &
+            &     e3u0_parent(jpi,jpj,jpk_parent), &
+            &     e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr) 
+         IF( ierr  > 0 )   CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed')
+       
+         ! Retrieve expected parent scale factors on child grid:
+         Agrif_UseSpecialValue = .FALSE.
+         e3t0_parent(:,:,:) = 0._wp
+         CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap)
+         !
+         ! Deduce scale factors at U and V points:
+         DO_3D( 0, 0, 0, 0, 1, jpk_parent )
+            e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj  ,jk))
+            e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji  ,jj+1,jk))
+         END_3D
+
+         ! Assume a step at the bottom except if (pure) s-coordinates
+         IF ( .NOT.Agrif_Parent(ln_sco) ) THEN 
+            DO_2D( 1, 0, 1, 0 )
+               jk = mbku_parent(ji,jj)
+               e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj  ,jk))
+               jk = mbkv_parent(ji,jj)
+               e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji  ,jj+1,jk))
+            END_2D
+         ENDIF
+
+         CALL lbc_lnk_multi( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp )
       ENDIF
 
@@ -305 +262 @@
          !
          kindic_agr = 0
-         IF( .NOT. l_vremap ) THEN
+         IF( .NOT. ln_vert_remap ) THEN
             !
             ! check if tmask and vertical scale factors agree with parent in sponge area:
@@ -313 +270 @@
             !
             ! In case of vertical interpolation, check only that total depths agree between child and parent:
-            DO ji = 1, jpi
-               DO jj = 1, jpj
-                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-               END DO
-            END DO
-
-            CALL mpp_sum( 'agrif_user', kindic_agr )
+                  
+            CALL Agrif_check_bat( kindic_agr )           
+
+            CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
             IF( kindic_agr /= 0 ) THEN
                CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
@@ -330 +282 @@
          ENDIF
       ENDIF
-
-      IF( l_vremap ) THEN
-      ! Additional constrain that should be removed someday:
-         IF ( Agrif_Parent(jpk).GT.jpk ) THEN
-            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' )
-         ENDIF
-      ENDIF
+      !
+      WHERE (ssumask(:,:) == 0._wp) mbku_parent(:,:) = 0
+      WHERE (ssvmask(:,:) == 0._wp) mbkv_parent(:,:) = 0
+      WHERE (ssmask(:,:)  == 0._wp) mbkt_parent(:,:) = 0
       !
    END SUBROUTINE Agrif_Init_Domain
@@ -365 +314 @@
       LOGICAL :: check_namelist
       CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
-      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
-      INTEGER :: ji, jj
 
       ! 1. Declaration of the type of variable which have to be interpolated
@@ -376 +323 @@
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn)
+      l_vremap              = ln_vert_remap
+
+      CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn)
       CALL Agrif_Sponge
       tabspongedone_tsn = .FALSE.
-      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
+      CALL Agrif_Bc_variable(ts_sponge_id,calledweight=1.,procname=interptsn_sponge)
       ! reset tsa to zero
       ts(:,:,:,:,Krhs_a) = 0._wp
@@ -394 +343 @@
       tabspongedone_v = .FALSE.
       CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
+      IF (nn_shift_bar>0) THEN
+         CALL Agrif_Sponge_2d
+         tabspongedone_u = .FALSE.
+         tabspongedone_v = .FALSE.
+         CALL Agrif_Bc_variable(unb_sponge_id,calledweight=1.,procname=interpunb_sponge)
+         tabspongedone_u = .FALSE.
+         tabspongedone_v = .FALSE.
+         CALL Agrif_Bc_variable(vnb_sponge_id,calledweight=1.,procname=interpvnb_sponge)
+      ENDIF
       use_sign_north = .FALSE.
       uu(:,:,:,Krhs_a) = 0._wp
@@ -407 +365 @@
          use_sign_north = .TRUE.
          sign_north = -1.
+         CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
          CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)   ! must be called before unb_id to define ubdy
          CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)   ! must be called before vnb_id to define vbdy
-         CALL Agrif_Bc_variable(        unb_id,calledweight=1.,procname=interpunb )
-         CALL Agrif_Bc_variable(        vnb_id,calledweight=1.,procname=interpvnb )
          use_sign_north = .FALSE.
          ubdy(:,:) = 0._wp
          vbdy(:,:) = 0._wp
+      ELSE
+         Agrif_UseSpecialValue = ln_spc_dyn
+         use_sign_north = .TRUE.
+         sign_north = -1.
+         CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
+         use_sign_north = .FALSE.
+         ubdy(:,:) = 0._wp
+         vbdy(:,:) = 0._wp
       ENDIF
       Agrif_UseSpecialValue = .FALSE. 
+      l_vremap              = .FALSE.
 
       !-----------------
@@ -464 +432 @@
       IMPLICIT NONE
       !
-      INTEGER :: ind1, ind2, ind3
+      INTEGER :: ind1, ind2, ind3, imaxrho
       !!----------------------------------------------------------------------
 
@@ -472 +440 @@
       ind2 = nn_hls + 2 + nbghostcells_x
       ind3 = nn_hls + 2 + nbghostcells_y_s
-# if defined key_vertical
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id)
+      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
+
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_interp_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_update_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_sponge_id)
       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
@@ -481 +451 @@
       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
-# else
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id)
-# endif
-      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
-      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
+
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,sshn_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_sponge_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_sponge_id)
       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
-
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_update_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_update_id)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,ub2b_cor_id)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,vb2b_cor_id)
 !      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
 !      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
-      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
 
 
@@ -506 +472 @@
 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
-# if defined key_vertical
          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
-# else
-         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id)
-# endif
       ENDIF
      
       ! 2. Type of interpolation
       !-------------------------
-      CALL Agrif_Set_bcinterp(       tsn_id,interp =AGRIF_linear)
-      CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
-      CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
-
-      CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear)
-      CALL Agrif_Set_bcinterp(  un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
-      CALL Agrif_Set_bcinterp(  vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
-
-      CALL Agrif_Set_bcinterp(       sshn_id,interp =AGRIF_linear)
-      CALL Agrif_Set_bcinterp(        unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
-      CALL Agrif_Set_bcinterp(        vnb_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
-      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
-      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
-!
-! > Divergence conserving alternative:
-!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
-!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
-!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
-!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
-!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
-!<
+      CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
+      CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
+
+#if defined DIV_CONS
+      lk_tint2d_notinterp = .TRUE.
+      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
+      CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
+      CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
+      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
+      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
+#else
+      lk_tint2d_notinterp = .FALSE.
+      CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
+      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
+      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+#endif
+
+      CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
+      CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
+      CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
+      CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
+
+      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
+      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
+
+      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
+      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
 
       IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
@@ -545 +513 @@
       ! 3. Location of interpolation
       !-----------------------------
-      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
-      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 
-      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
-
-      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2 
-      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3: 
-      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11
-
-      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
-      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
-
+      CALL Agrif_Set_bc(  ts_interp_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
+      CALL Agrif_Set_bc(  un_interp_id, (/0,ind1-1/) ) 
+      CALL Agrif_Set_bc(  vn_interp_id, (/0,ind1-1/) )
+
+      CALL Agrif_Set_bc(  ts_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2 
+      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! and nbghost=3: 
+      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! columns 4 to 11
+
+      CALL Agrif_Set_bc(       sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+      CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+      CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+      CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+      CALL Agrif_Set_bc(vb2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+      CALL Agrif_Set_bc( unb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)*imaxrho,-imaxrho*nn_shift_bar/) )
+      CALL Agrif_Set_bc( vnb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)*imaxrho,-imaxrho*nn_shift_bar/) )
+      CALL Agrif_Set_bc(   ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
+      CALL Agrif_Set_bc(   vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
       IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
 !!$      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )  
@@ -567 +538 @@
 
 # if defined UPD_HIGH
-      CALL Agrif_Set_Updatetype(      tsn_id,update  = Agrif_Update_Full_Weighting)
-      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
-      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
-
+      CALL Agrif_Set_Updatetype(  ts_interp_id,update  = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(  un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(  vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
+
+      CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
+      CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
@@ -583 +556 @@
 
 #else
-      CALL Agrif_Set_Updatetype(     tsn_id, update  = AGRIF_Update_Average)
-      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
-      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
-
+      CALL Agrif_Set_Updatetype(  ts_update_id,update  = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(  un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(  vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
+
+      CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
@@ -682 +657 @@
       CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear)
       CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear)
-      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  )
-      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   )
+      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear)
+      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear)
       CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear)
       CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear)
@@ -751 +726 @@
       CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
       ! reset tsa to zero
-      tra(:,:,:,:) = 0._wp
+      tr(:,:,:,:,Krhs_a) = 0._wp
 
       ! 3. Some controls
@@ -797 +772 @@
       IMPLICIT NONE
       !
-      INTEGER :: ind1, ind2, ind3
+      INTEGER :: ind1, ind2, ind3, imaxrho
       !!----------------------------------------------------------------------
 !RB_CMEMS : declare here init for top      
@@ -805 +780 @@
       ind2 = nn_hls + 2 + nbghostcells_x
       ind3 = nn_hls + 2 + nbghostcells_y_s
-# if defined key_vertical
+      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
+
       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
-# else
-! LAURENT: STRANGE why (3,3) here ?
-      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id)
-# endif
 
       ! 2. Type of interpolation
@@ -822 +793 @@
       !-----------------------------
       CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
-      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*imaxrho-1,0/))
 
       ! 4. Update type
@@ -863 +834 @@
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
-                       & ln_spc_dyn, ln_chk_bathy
+                       & ln_spc_dyn, ln_vert_remap, ln_chk_bathy
       !!--------------------------------------------------------------------------------------
       !
@@ -884 +855 @@
          WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn
          WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+         WRITE(numout,*) '      vertical remapping                ln_vert_remap = ', ln_vert_remap
          WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
       ENDIF
 
+! JC => side effects of lines below to be checked:
       lk_west  = .NOT. ( Agrif_Ix() == 1 )
-      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 )
+      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 )
       lk_south = .NOT. ( Agrif_Iy() == 1 )
-      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 )
-
+      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 )
       !
       ! Set the number of ghost cells according to periodicity
@@ -900 +872 @@
       IF(   jperio == 1  )   nbghostcells_x   = 0
       IF( .NOT. lk_south )   nbghostcells_y_s = 0
+      IF( .NOT. lk_north )   nbghostcells_y_n = 0
+      !
       ! Some checks
       IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    &
@@ -906 +880 @@
          &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' )
       IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
+      !
       !
    END SUBROUTINE agrif_nemo_init

NEMO/trunk/src/NST/vremap.F90

@@ -320 +320 @@
       ! specify methods
 !      opts%edge_meth = p1e_method     ! 1st-order edge interp.
+!      opts%cell_meth = pcm_method
 !      opts%cell_meth = plm_method     ! PLM method in cells
       opts%edge_meth = p3e_method     ! 3rd-order edge interp.
@@ -328 +329 @@
       ! limiter
 !      opts%cell_lims = null_limit     ! no lim.
+!      opts%cell_lims = weno_limit
       opts%cell_lims = mono_limit     ! monotone limiter   
  
@@ -376 +378 @@
       DO jkout = 1, kjpk_out !  Loop over destination grid
          !
-         IF     ( pzout(jkout) <=  pzin(  1    ) ) THEN  ; ptout(jkout,1:kn_var) = ptin(    1    ,1:kn_var)         
-         ELSEIF ( pzout(jkout) >= pzin(kjpk_in) ) THEN   ; ptout(jkout,1:kn_var) = ptin( kjpk_in ,1:kn_var)
+         IF     ( pzout(jkout) <=  pzin(  1    ) ) THEN ! Surface extrapolation  
+            DO jn = 1, kn_var 
+! linear
+!               ptout(jkout,jn) = ptin(1 ,jn) + &
+!                               & (pzout(jkout) - pzin(1)) / (pzin(2)    - pzin(1)) &
+!                               &                          * (ptin(2,jn) - ptin(1,jn))
+               ptout(jkout,jn) = ptin(1,jn)
+            END DO
+         ELSEIF ( pzout(jkout) >= pzin(kjpk_in) ) THEN ! Bottom extrapolation 
+            DO jn = 1, kn_var 
+! linear
+!               ptout(jkout,jn) = ptin(kjpk_in ,jn) + &
+!                               & (pzout(jkout) - pzin(kjpk_in)) / (pzin(kjpk_in)    - pzin(kjpk_in-1)) &
+!                               &                                * (ptin(kjpk_in,jn) - ptin(kjpk_in-1,jn))
+               ptout(jkout,jn) = ptin(kjpk_in ,jn)
+            END DO
          ELSEIF ( ( pzout(jkout) > pzin(1) ).AND.( pzout(jkout) < pzin(kjpk_in) )) THEN
             DO jkin = 1, kjpk_in - 1 !  Loop over source grid