Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN

Timestamp:

2020-09-14T17:40:34+02:00 (4 years ago)

Author:

andmirek

Message:

Ticket #2195:update to trunk 13461

Location:

NEMO/branches/2019/dev_r11351_fldread_with_XIOS

Files:

• . (modified) (1 prop)
• src/OCE/DYN/divhor.F90 (modified) (5 diffs)
• src/OCE/DYN/dynadv.F90 (modified) (6 diffs)
• src/OCE/DYN/dynadv_cen2.F90 (modified) (5 diffs)
• src/OCE/DYN/dynadv_ubs.F90 (modified) (6 diffs)
• src/OCE/DYN/dynatf.F90 (copied) (copied from NEMO/trunk/src/OCE/DYN/dynatf.F90)
• src/OCE/DYN/dynatf_qco.F90 (copied) (copied from NEMO/trunk/src/OCE/DYN/dynatf_qco.F90)
• src/OCE/DYN/dynhpg.F90 (modified) (33 diffs)
• src/OCE/DYN/dynkeg.F90 (modified) (6 diffs)
• src/OCE/DYN/dynldf.F90 (modified) (4 diffs)
• src/OCE/DYN/dynldf_iso.F90 (modified) (13 diffs)
• src/OCE/DYN/dynldf_lap_blp.F90 (modified) (7 diffs)
• src/OCE/DYN/dynnxt.F90 (deleted)
• src/OCE/DYN/dynspg.F90 (modified) (12 diffs)
• src/OCE/DYN/dynspg_exp.F90 (modified) (4 diffs)
• src/OCE/DYN/dynspg_ts.F90 (modified) (38 diffs)
• src/OCE/DYN/dynvor.F90 (modified) (35 diffs)
• src/OCE/DYN/dynzad.F90 (modified) (4 diffs)
• src/OCE/DYN/dynzdf.F90 (modified) (10 diffs)
• src/OCE/DYN/sshwzv.F90 (modified) (18 diffs)
• src/OCE/DYN/wet_dry.F90 (modified) (16 diffs)

NEMO/branches/2019/dev_r11351_fldread_with_XIOS

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/divhor.F90

@@ -20 +20 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoff 
-   USE sbcisf          ! ice shelf
-   USE iscplhsb        ! ice sheet / ocean coupling
-   USE iscplini        ! ice sheet / ocean coupling
+   USE sbc_oce, ONLY : ln_rnf      ! river runoff
+   USE sbcrnf , ONLY : sbc_rnf_div ! river runoff 
+   USE isf_oce, ONLY : ln_isf      ! ice shelf
+   USE isfhdiv, ONLY : isf_hdiv    ! ice shelf
 #if defined key_asminc   
    USE asminc          ! Assimilation increment
@@ -40 +39 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48 +48 @@
 CONTAINS
 
-   SUBROUTINE div_hor( kt )
+   SUBROUTINE div_hor( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE div_hor  ***
@@ -55 +55 @@
       !!
       !! ** Method  :   the now divergence is computed as :
-      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!         hdiv = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
       !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 
       !!
-      !! ** Action  : - update hdivn, the now horizontal divergence
+      !! ** Action  : - update hdiv, the now horizontal divergence
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time level indices
       !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
       REAL(wp) ::   zraur, zdep   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp
       !!----------------------------------------------------------------------
       !
@@ -72 +74 @@
          IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
          IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step
       ENDIF
       !
-      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)      &
-                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)      &
-                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)      &
-                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)  )   &
-                  &            * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-            END DO  
-         END DO  
-      END DO
-#if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN
-         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(   2   ,  :   ,:) = 0._wp      ! west
-         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-1,  :   ,:) = 0._wp      ! east
-         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(   :   ,  2   ,:) = 0._wp      ! south
-         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(   :   ,nlcj-1,:) = 0._wp      ! north
-      ENDIF
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      &
+            &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      &
+            &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      &
+            &               - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   &
+            &            * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+      END_3D
+      !
+      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field)
+      !
+#if defined key_asminc 
+      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, Kbb, Kmm, hdiv )   !==  SSH assimilation  ==!   (update hdiv field)
+      ! 
 #endif
       !
-      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field)
+      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field)
       !
-#if defined key_asminc 
-      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, hdivn )   !==  SSH assimilation  ==!   (update hdivn field)
-      ! 
-#endif
-      IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field)
-      !
-      IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field)
-      !
-      CALL lbc_lnk( 'divhor', hdivn, 'T', 1. )   !   (no sign change)
+      CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change)
       !
       IF( ln_timing )   CALL timing_stop('div_hor')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynadv.F90

@@ -44 +44 @@
    INTEGER, PUBLIC, PARAMETER ::   np_FLX_ubs = 3   ! flux   form : 3rd order Upstream Biased Scheme
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -53 +51 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv( kt )
+   SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv  ***
@@ -59 +57 @@
       !! ** Purpose :   compute the ocean momentum advection trend.
       !!
-      !! ** Method  : - Update (ua,va) with the advection term following n_dynadv
+      !! ** Method  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the advection term following n_dynadv
       !!
       !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T) 
@@ -66 +64 @@
       !!      (see dynvor module).
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !!----------------------------------------------------------------------
       !
@@ -73 +73 @@
       SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==!
       CASE( np_VEC_c2  )     
-         CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
-         CALL dyn_zad     ( kt )               ! vector form : vertical advection
+         CALL dyn_keg     ( kt, nn_dynkeg,      Kmm, puu, pvv, Krhs )    ! vector form : horizontal gradient of kinetic energy
+         CALL dyn_zad     ( kt,                 Kmm, puu, pvv, Krhs )    ! vector form : vertical advection
       CASE( np_FLX_c2  ) 
-         CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme
+         CALL dyn_adv_cen2( kt,                 Kmm, puu, pvv, Krhs )    ! 2nd order centered scheme
       CASE( np_FLX_ubs )   
-         CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3)
+         CALL dyn_adv_ubs ( kt,            Kbb, Kmm, puu, pvv, Krhs )    ! 3rd order UBS      scheme (UP3)
       END SELECT
       !
@@ -104 +104 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
       READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
-      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' )
       READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' )
       IF(lwm) WRITE ( numond, namdyn_adv )
 

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynadv_cen2.F90

@@ -27 +27 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -35 +36 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv_cen2( kt )
+   SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv_cen2  ***
@@ -44 +45 @@
       !! ** Method  :   Trend evaluated using now fields (centered in time) 
       !!
-      !! ** Action  :   (ua,va) updated with the now vorticity term trend
+      !! ** Action  :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the now vorticity term trend
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt           ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs    ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -60 +63 @@
       !
       IF( l_trddyn ) THEN           ! trends: store the input trends
-         zfu_uw(:,:,:) = ua(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
@@ -67 +70 @@
       !
       DO jk = 1, jpkm1                    ! horizontal transport
-         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
-         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point)
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
-               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) )
-               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) )
-               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
-            END DO
-         END DO
-         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
-                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
+         DO_2D( 1, 0, 1, 0 )
+            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )
+            zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
+            zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
+            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) )
+         END_2D
+         DO_2D( 0, 0, 0, 0 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   &
+               &                           / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj)   &
+               &                           / e3v(ji,jj,jk,Kmm)
+         END_2D
       END DO
       !
       IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic
-         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
-         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
-         zfu_t(:,:,:) = ua(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
       !                             !==  Vertical advection  ==!
       !
-      DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero
-         DO ji = fs_2, fs_jpim1
-            zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp
-            zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp
+         zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp
+      END_2D
       IF( ln_linssh ) THEN                ! linear free surface: advection through the surface
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
-               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+         END_2D
       ENDIF
       DO jk = 2, jpkm1                    ! interior advective fluxes
-         DO jj = 2, jpj                       ! 1/4 * Vertical transport
-            DO ji = 2, jpi
-               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-            END DO
-         END DO
+         DO_2D( 0, 1, 0, 1 )
+            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D( 0, 0, 0, 0 )
+            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+         END_2D
       END DO
-      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   &
+            &                                      / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj)   &
+            &                                      / e3v(ji,jj,jk,Kmm)
+      END_3D
       !
       IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic
-         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
-         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
       ENDIF
       !                                   ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
    END SUBROUTINE dyn_adv_cen2

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynadv_ubs.F90

@@ -33 +33 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -41 +42 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv_ubs( kt )
+   SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv_ubs  ***
@@ -64 +65 @@
       !!      gamma1=1/3 and gamma2=1/32.
       !!
-      !! ** Action : - (ua,va) updated with the 3D advective momentum trends
+      !! ** Action : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the 3D advective momentum trends
       !!
       !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt              ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -95 +98 @@
       !
       IF( l_trddyn ) THEN           ! trends: store the input trends
-         zfu_uw(:,:,:) = ua(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !                                      ! =========================== !
@@ -102 +105 @@
          !                                   ! =========================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
          !            
-         DO jj = 2, jpjm1                          ! laplacian
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk)
-               zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
-               zlu_uv(ji,jj,jk,1) = ( ub (ji  ,jj+1,jk) - ub (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( ub (ji  ,jj  ,jk) - ub (ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
-               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj  ,jk) - vb (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( vb (ji  ,jj  ,jk) - vb (ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
-               !
-               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
-               zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
-               zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
-               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk)
+            !
+            zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
+         END_2D
       END DO
-      CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1.,  &
-                      &   zlu_uu(:,:,:,2), 'U', 1. , zlu_uv(:,:,:,2), 'U', 1.,  & 
-                      &   zlv_vv(:,:,:,1), 'V', 1. , zlv_vu(:,:,:,1), 'V', 1.,  &
-                      &   zlv_vv(:,:,:,2), 'V', 1. , zlv_vu(:,:,:,2), 'V', 1.   )
+      CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  &
+                      &   zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  & 
+                      &   zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  &
+                      &   zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   )
       !
       !                                      ! ====================== !
@@ -132 +133 @@
       DO jk = 1, jpkm1                       ! ====================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
          !
-         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
-               zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
-               !
-               IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
-               ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
-               ENDIF
-               IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
-               ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
-               ENDIF
-               !
-               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
-                  &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
-                  &                * ( zui - gamma1 * zl_u)
-               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
-                  &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
-                  &                * ( zvj - gamma1 * zl_v)
-               !
-               zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
-               zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
-               IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
-               ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
-               ENDIF
-               IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
-               ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
-               ENDIF
-               !
-               zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   &
-                  &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u )
-               zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   &
-                  &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v )
-            END DO
-         END DO
-         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
-                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D( 1, 0, 1, 0 )
+            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )
+            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) )
+            !
+            IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
+            ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
+            ENDIF
+            IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
+            ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
+            ENDIF
+            !
+            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
+               &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
+               &                * ( zui - gamma1 * zl_u)
+            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
+               &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
+               &                * ( zvj - gamma1 * zl_v)
+            !
+            zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
+            zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
+            IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
+            ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
+            ENDIF
+            IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
+            ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
+            ENDIF
+            !
+            zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   &
+               &                * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) - gamma1 * zl_u )
+            zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   &
+               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v )
+         END_2D
+         DO_2D( 0, 0, 0, 0 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   &
+               &                           / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj)   &
+               &                           / e3v(ji,jj,jk,Kmm)
+         END_2D
       END DO
       IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic
-         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
-         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
-         zfu_t(:,:,:) = ua(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !                                      ! ==================== !
       !                                      !  Vertical advection  !
       !                                      ! ==================== !
-      DO jj = 2, jpjm1                             ! surface/bottom advective fluxes set to zero                  
-         DO ji = fs_2, fs_jpim1
-            zfu_uw(ji,jj,jpk) = 0._wp
-            zfv_vw(ji,jj,jpk) = 0._wp
-            zfu_uw(ji,jj, 1 ) = 0._wp
-            zfv_vw(ji,jj, 1 ) = 0._wp
-         END DO
+      DO_2D( 0, 0, 0, 0 )
+         zfu_uw(ji,jj,jpk) = 0._wp
+         zfv_vw(ji,jj,jpk) = 0._wp
+         zfu_uw(ji,jj, 1 ) = 0._wp
+         zfv_vw(ji,jj, 1 ) = 0._wp
+      END_2D
+      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
+         DO_2D( 0, 0, 0, 0 )
+            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+         END_2D
+      ENDIF
+      DO jk = 2, jpkm1                          ! interior fluxes
+         DO_2D( 0, 1, 0, 1 )
+            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D( 0, 0, 0, 0 )
+            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+         END_2D
       END DO
-      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
-               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-      DO jk = 2, jpkm1                          ! interior fluxes
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-            END DO
-         END DO
-      END DO
-      DO jk = 1, jpkm1                          ! divergence of vertical momentum flux divergence
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   &
+            &                                       / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj)   &
+            &                                       / e3v(ji,jj,jk,Kmm)
+      END_3D
       !
       IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic
-         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
-         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
       ENDIF
       !                                         ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
    END SUBROUTINE dyn_adv_ubs

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynhpg.F90

@@ -31 +31 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
+   USE isf_oce , ONLY : risfload  ! ice shelf  (risfload variable)
+   USE isfload , ONLY : isf_load  ! ice shelf  (isf_load routine )
    USE sbc_oce         ! surface variable (only for the flag with ice shelf)
    USE dom_oce         ! ocean space and time domain
@@ -37 +39 @@
    USE trd_oce         ! trends: ocean variables
    USE trddyn          ! trend manager: dynamics
-!jc   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
+   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
    !
    USE in_out_manager  ! I/O manager
@@ -73 +75 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -81 +85 @@
 CONTAINS
 
-   SUBROUTINE dyn_hpg( kt )
+   SUBROUTINE dyn_hpg( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_hpg  ***
@@ -88 +92 @@
       !!              using the scheme defined in the namelist
       !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
       !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
+      !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
       !!----------------------------------------------------------------------
@@ -97 +104 @@
       IF( ln_timing )   CALL timing_start('dyn_hpg')
       !
-      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn)
+      IF( l_trddyn ) THEN                    ! Temporary saving of puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends (l_trddyn)
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
       SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation
-      CASE ( np_zco )   ;   CALL hpg_zco    ( kt )      ! z-coordinate
-      CASE ( np_zps )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation)
-      CASE ( np_sco )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation)
-      CASE ( np_djc )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial)
-      CASE ( np_prj )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme)
-      CASE ( np_isf )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf
+      CASE ( np_zco )   ;   CALL hpg_zco    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate
+      CASE ( np_zps )   ;   CALL hpg_zps    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate plus partial steps (interpolation)
+      CASE ( np_sco )   ;   CALL hpg_sco    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (standard jacobian formulation)
+      CASE ( np_djc )   ;   CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial)
+      CASE ( np_prj )   ;   CALL hpg_prj    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Pressure Jacobian scheme)
+      CASE ( np_isf )   ;   CALL hpg_isf    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate similar to sco modify for ice shelf
       END SELECT
       !
       IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_hpg')
@@ -127 +134 @@
 
 
-   SUBROUTINE dyn_hpg_init
+   SUBROUTINE dyn_hpg_init( Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE dyn_hpg_init  ***
@@ -137 +144 @@
       !!      with the type of vertical coordinate used (zco, zps, sco)
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: Kmm   ! ocean time level index
+      !
       INTEGER ::   ioptio = 0      ! temporary integer
       INTEGER ::   ios             ! Local integer output status for namelist read
@@ -150 +159 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient
       READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist' )
+      !
       READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist' )
       IF(lwm) WRITE ( numond, namdyn_hpg )
       !
@@ -213 +220 @@
       ENDIF
       !                          
-      IF ( .NOT. ln_isfcav ) THEN     !--- no ice shelf load
-         riceload(:,:) = 0._wp
-         !
-      ELSE                            !--- set an ice shelf load
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ice shelf case: set the ice-shelf load'
-         ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) ) 
-         !
-         znad = 1._wp                     !- To use density and not density anomaly
-         !
-         !                                !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
-         zts_top(:,:,jp_tem) = -1.9_wp   ;   zts_top(:,:,jp_sal) = 34.4_wp
-         !
-         DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf 
-            CALL eos( zts_top(:,:,:), gdept_n(:,:,jk), zrhd(:,:,jk) )
-         END DO
-         !
-         !                                !- compute rhd at the ice/oce interface (ice shelf side)
-         CALL eos( zts_top , risfdep, zrhdtop_isf )
-         !
-         !                                !- Surface value + ice shelf gradient
-         ziceload = 0._wp                       ! compute pressure due to ice shelf load 
-         DO jj = 1, jpj                         ! (used to compute hpgi/j for all the level from 1 to miku/v)
-            DO ji = 1, jpi                      ! divided by 2 later
-               ikt = mikt(ji,jj)
-               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1))
-               DO jk = 2, ikt-1
-                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) &
-                     &                              * (1._wp - tmask(ji,jj,jk))
-               END DO
-               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
-                  &                                              * ( risfdep(ji,jj) - gdept_n(ji,jj,ikt-1) )
-            END DO
-         END DO
-         riceload(:,:) = ziceload(:,:)  ! need to be saved for diaar5
-         !
-         DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload ) 
-      ENDIF
-      !
    END SUBROUTINE dyn_hpg_init
 
 
-   SUBROUTINE hpg_zco( kt )
+   SUBROUTINE hpg_zco( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_zco  ***
@@ -266 +233 @@
       !!      level:    zhpi = grav .....
       !!                zhpj = grav .....
-      !!      add it to the general momentum trend (ua,va).
-      !!            ua = ua - 1/e1u * zhpi
-      !!            va = va - 1/e2v * zhpj
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!            puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!            pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
@@ -288 +257 @@
 
       ! Surface value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       !
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! hydrostatic pressure gradient
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    &
-                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
-
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    &
-                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+            &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    &
+            &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
+
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+            &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    &
+            &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE hpg_zco
 
 
-   SUBROUTINE hpg_zps( kt )
+   SUBROUTINE hpg_zps( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE hpg_zps  ***
@@ -330 +293 @@
       !! ** Method  :   z-coordinate plus partial steps case.  blahblah...
       !!
-      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !! ** Action  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk                       ! dummy loop indices
@@ -338 +303 @@
       REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj
+      REAL(wp), DIMENSION(jpi,jpj) :: zgtsu, zgtsv, zgru, zgrv
       !!----------------------------------------------------------------------
       !
@@ -346 +312 @@
       ENDIF
 
-      ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level
-!jc      CALL zps_hde    ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv )
+      ! Partial steps: Compute NOW horizontal gradient of t, s, rd at the last ocean level
+      CALL zps_hde( kt, Kmm, jpts, ts(:,:,:,:,Kmm), zgtsu, zgtsv, rhd, zgru , zgrv )
 
       ! Local constant initialization
@@ -353 +319 @@
 
       !  Surface value (also valid in partial step case)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! hydrostatic pressure gradient
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
-                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
-
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
-                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90)
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) )
-            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) )
-            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
-               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
-                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
-            ENDIF
-            IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value
-               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
-                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
-            ENDIF
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+            &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
+            &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
+
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+            &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
+            &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
+
+      ! partial steps correction at the last level  (use zgru & zgrv computed in zpshde.F90)
+      DO_2D( 0, 0, 0, 0 )
+         iku = mbku(ji,jj)
+         ikv = mbkv(ji,jj)
+         zcoef2 = zcoef0 * MIN( e3w(ji,jj,iku,Kmm), e3w(ji+1,jj  ,iku,Kmm) )
+         zcoef3 = zcoef0 * MIN( e3w(ji,jj,ikv,Kmm), e3w(ji  ,jj+1,ikv,Kmm) )
+         IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
+            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) - zhpi(ji,jj,iku)         ! subtract old value
+            zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
+               &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + zgru(ji,jj) ) * r1_e1u(ji,jj)
+            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
+         ENDIF
+         IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
+            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) - zhpj(ji,jj,ikv)         ! subtract old value
+            zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
+               &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + zgrv(ji,jj) ) * r1_e2v(ji,jj)
+            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
+         ENDIF
+      END_2D
       !
    END SUBROUTINE hpg_zps
 
 
-   SUBROUTINE hpg_sco( kt )
+   SUBROUTINE hpg_sco( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_sco  ***
@@ -422 +380 @@
       !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
       !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
-      !!      add it to the general momentum trend (ua,va).
-      !!         ua = ua - 1/e1u * zhpi
-      !!         va = va - 1/e2v * zhpj
-      !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices
@@ -451 +411 @@
       !
       IF( ln_wd_il ) THEN
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) +  ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                       > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (       &
-                  &    MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
-        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
+        DO_2D( 0, 0, 0, 0 )
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)               ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) +  ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                       > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)              -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (       &
+               &    MAX(   ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) )
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+          ELSE
+            zcpy(ji,jj) = 0._wp
+          END IF
+        END_2D
+        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       END IF
 
       ! Surface value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ! hydrostatic pressure gradient along s-surfaces
-            zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
-            ! s-coordinate pressure gradient correction
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-            !
-            IF( ln_wd_il ) THEN
-               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-               zuap = zuap * zcpx(ji,jj)
-               zvap = zvap * zcpy(ji,jj)
-            ENDIF
-            !
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,1) =   &
+            &  zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    &
+            &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) &
+            &           * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) =   &
+            &  zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    &
+            &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) &
+            &           * r1_e2v(ji,jj)
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj)
+         !
+         IF( ln_wd_il ) THEN
+            zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+            zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+            zuap = zuap * zcpx(ji,jj)
+            zvap = zvap * zcpy(ji,jj)
+         ENDIF
+         !
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) + zuap
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) + zvap
+      END_2D
 
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj)
-               !
-               IF( ln_wd_il ) THEN
-                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-                  zuap = zuap * zcpx(ji,jj)
-                  zvap = zvap * zcpy(ji,jj)
-               ENDIF
-               !
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
+            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
+            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
+            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) * r1_e2v(ji,jj)
+         !
+         IF( ln_wd_il ) THEN
+            zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+            zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+            zuap = zuap * zcpx(ji,jj)
+            zvap = zvap * zcpy(ji,jj)
+         ENDIF
+         !
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) + zuap
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) + zvap
+      END_3D
       !
       IF( ln_wd_il )  DEALLOCATE( zcpx , zcpy )
@@ -556 +512 @@
 
 
-   SUBROUTINE hpg_isf( kt )
+   SUBROUTINE hpg_isf( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_isf  ***
@@ -568 +524 @@
       !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
       !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
-      !!      add it to the general momentum trend (ua,va).
-      !!         ua = ua - 1/e1u * zhpi
-      !!         va = va - 1/e2v * zhpj
-      !!      iceload is added and partial cell case are added to the top and bottom
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!      iceload is added
       !!      
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices
@@ -596 +554 @@
         DO jj = 1, jpj
           ikt = mikt(ji,jj)
-          zts_top(ji,jj,1) = tsn(ji,jj,ikt,1)
-          zts_top(ji,jj,2) = tsn(ji,jj,ikt,2)
+          zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm)
+          zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm)
         END DO
       END DO
@@ -605 +563 @@
 !===== Compute surface value ===================================================== 
 !==================================================================================
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ikt    = mikt(ji,jj)
-            iktp1i = mikt(ji+1,jj)
-            iktp1j = mikt(ji,jj+1)
-            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
-            ! we assume ISF is in isostatic equilibrium
-            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            ) 
-            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            ) 
-            ! s-coordinate pressure gradient correction (=0 if z coordinate)
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         ikt    = mikt(ji,jj)
+         iktp1i = mikt(ji+1,jj)
+         iktp1j = mikt(ji,jj+1)
+         ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
+         ! we assume ISF is in isostatic equilibrium
+         zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w(ji+1,jj,iktp1i,Kmm)                                    &
+            &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
+            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         &
+            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+            &                                  + ( risfload(ji+1,jj) - risfload(ji,jj))                            ) 
+         zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm)                                    &
+            &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
+            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         & 
+            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+            &                                  + ( risfload(ji,jj+1) - risfload(ji,jj))                            ) 
+         ! s-coordinate pressure gradient correction (=0 if z coordinate)
+         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
+      END_2D
 !==================================================================================     
 !===== Compute interior value ===================================================== 
 !==================================================================================
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj)
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+            &           * (  e3w(ji+1,jj,jk,Kmm)                   &
+            &                  * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
+            &              - e3w(ji  ,jj,jk,Kmm)                   &
+            &                  * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+            &           * (  e3w(ji,jj+1,jk,Kmm)                   &
+            &                  * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
+            &              - e3w(ji,jj  ,jk,Kmm)                   &
+            &                  * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) / e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) / e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE hpg_isf
 
 
-   SUBROUTINE hpg_djc( kt )
+   SUBROUTINE hpg_djc( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_djc  ***
@@ -669 +625 @@
       !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
@@ -685 +643 @@
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
-        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
+        DO_2D( 0, 0, 0, 0 )
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) )
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+          ELSE
+            zcpy(ji,jj) = 0._wp
+          END IF
+        END_2D
+        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       END IF
 
@@ -743 +699 @@
 !!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
-               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1)
-               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
-               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  )
-               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
-               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  )
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
+         dzz  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji,jj,jk-1)
+         drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
+         dzx  (ji,jj,jk) = gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk  )
+         drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
+         dzy  (ji,jj,jk) = gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk  )
+      END_3D
 
       !-------------------------------------------------------------------------
@@ -764 +716 @@
 !!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
-
-               cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
-               cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
-
-               cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
-               cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
-
-               IF( cffw > zep) THEN
-                  drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
-                     &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
-               ELSE
-                  drhow(ji,jj,jk) = 0._wp
-               ENDIF
-
-               dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
-                  &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
-
-               IF( cffu > zep ) THEN
-                  drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
-                     &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
-               ELSE
-                  drhou(ji,jj,jk ) = 0._wp
-               ENDIF
-
-               IF( cffx > zep ) THEN
-                  dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
-                     &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
-               ELSE
-                  dzu(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffv > zep ) THEN
-                  drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
-                     &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
-               ELSE
-                  drhov(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffy > zep ) THEN
-                  dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
-                     &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
-               ELSE
-                  dzv(ji,jj,jk) = 0._wp
-               ENDIF
-
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
+
+         cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
+         cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
+
+         cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
+         cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
+
+         IF( cffw > zep) THEN
+            drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
+               &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
+         ELSE
+            drhow(ji,jj,jk) = 0._wp
+         ENDIF
+
+         dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
+            &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
+
+         IF( cffu > zep ) THEN
+            drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
+               &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
+         ELSE
+            drhou(ji,jj,jk ) = 0._wp
+         ENDIF
+
+         IF( cffx > zep ) THEN
+            dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
+               &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
+         ELSE
+            dzu(ji,jj,jk) = 0._wp
+         ENDIF
+
+         IF( cffv > zep ) THEN
+            drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
+               &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
+         ELSE
+            drhov(ji,jj,jk) = 0._wp
+         ENDIF
+
+         IF( cffy > zep ) THEN
+            dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
+               &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
+         ELSE
+            dzv(ji,jj,jk) = 0._wp
+         ENDIF
+
+      END_3D
 
       !----------------------------------------------------------------------------------
@@ -833 +781 @@
       !-------------------------------------------------------------
 
-!!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified
-!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               &
-               &                   * (  rhd(ji,jj,1)                                     &
-               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
-               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  &
-               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  )
-         END DO
-      END DO
+!!bug gm   :  e3w-gde3w(:,:,:) = 0.5*e3w  ....  and gde3w(:,:,2)-gde3w(:,:,1)=e3w(:,:,2,Kmm) ....   to be verified
+!          true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be
+
+      DO_2D( 0, 0, 0, 0 )
+         rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) )               &
+            &                   * (  rhd(ji,jj,1)                                     &
+            &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
+            &                              * ( e3w  (ji,jj,1,Kmm) - gde3w(ji,jj,1) )  &
+            &                              / ( gde3w(ji,jj,2) - gde3w(ji,jj,1) )  )
+      END_2D
 
 !!bug gm    : here also, simplification is possible
 !!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
-                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   &
-                  &            - grav * z1_10 * (                                                                   &
-                  &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
-                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
-                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
-                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
-                  &                             )
-
-               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
-                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
-                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
-                  &                            )
-
-               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
-                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
-                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
-                  &                            )
-
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. )
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+
+         rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
+            &                     * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) )                                   &
+            &            - grav * z1_10 * (                                                                   &
+            &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
+            &   * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
+            &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
+            &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
+            &                             )
+
+         rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
+            &                     * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) )                                   &
+            &            - grav* z1_10 * (                                                                    &
+            &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
+            &   * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
+            &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
+            &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
+            &                            )
+
+         rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
+            &                     * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) )                                   &
+            &            - grav* z1_10 * (                                                                    &
+            &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
+            &   * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
+            &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
+            &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
+            &                            )
+
+      END_3D
+      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1.0_wp, rho_i, 'U', 1.0_wp, rho_j, 'V', 1.0_wp )
 
       ! ---------------
       !  Surface value
       ! ---------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
-            IF( ln_wd_il ) THEN
-              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-            ENDIF
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
-         END DO
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
+         IF( ln_wd_il ) THEN
+           zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+           zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+         ENDIF
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       ! ----------------
       !  interior value   (2=<jk=<jpkm1)
       ! ----------------
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
-                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
-                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
-                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
-                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
-               IF( ln_wd_il ) THEN
-                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-               ENDIF
-               ! add to the general momentum trend
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
+            &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
+            &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
+            &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
+            &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
+         IF( ln_wd_il ) THEN
+           zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+           zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+         ENDIF
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
       !
       IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy )
@@ -931 +867 @@
 
 
-   SUBROUTINE hpg_prj( kt )
+   SUBROUTINE hpg_prj( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_prj  ***
@@ -940 +876 @@
       !!      all vertical coordinate systems
       !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
       !!----------------------------------------------------------------------
       INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear
-      INTEGER, INTENT(in) ::   kt                   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices
@@ -973 +911 @@
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
-         DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (         &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-              
-                zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (      &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-                zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
-
-               ELSE
-                  zcpy(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
+         DO_2D( 0, 0, 0, 0 )
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) )
+           
+             zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+             zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
+
+            ELSE
+               zcpy(ji,jj) = 0._wp
+            ENDIF
+         END_2D
+         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       ENDIF
 
@@ -1024 +960 @@
 
       ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate
-      DO jj = 1, jpj
-        DO ji = 1, jpi
-          jk = mbkt(ji,jj)+1
-          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
-          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
-          ELSEIF( jk < jpkm1 ) THEN
-             DO jkk = jk+1, jpk
-                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   &
-                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
-             END DO
-          ENDIF
-        END DO
-      END DO
+      DO_2D( 1, 1, 1, 1 )
+       jk = mbkt(ji,jj)
+       IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
+       ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
+       ELSEIF( jk < jpkm1 ) THEN
+          DO jkk = jk+1, jpk
+             zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   &
+                &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2))
+          END DO
+       ENDIF
+      END_2D
 
       ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)"
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad
-         END DO
-      END DO
-
-      DO jk = 2, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_2D( 1, 1, 1, 1 )
+         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad
+      END_2D
+
+      DO_3D( 1, 1, 1, 1, 2, jpk )
+         zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm)
+      END_3D
 
       fsp(:,:,:) = zrhh (:,:,:)
@@ -1062 +990 @@
 
       ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
-      DO jj = 2, jpj
-        DO ji = 2, jpi
-          zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
-             &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1)
-
-          ! assuming linear profile across the top half surface layer
-          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1
-        END DO
-      END DO
+      DO_2D( 0, 1, 0, 1 )
+       zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
+          &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm)
+
+       ! assuming linear profile across the top half surface layer
+       zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1
+      END_2D
 
       ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)"
-      DO jk = 2, jpkm1
-        DO jj = 2, jpj
-          DO ji = 2, jpi
-            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
-               &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
-               &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
-               &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
-          END DO
-        END DO
-      END DO
+      DO_3D( 0, 1, 0, 1, 2, jpkm1 )
+      zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
+         &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
+         &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
+         &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
+      END_3D
 
       ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
 
       ! Prepare zsshu_n and zsshv_n
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
+      DO_2D( 0, 0, 0, 0 )
 !!gm BUG ?    if it is ssh at u- & v-point then it should be:
-!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * &
+!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * &
 !                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * &
+!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji,jj+1) * ssh(ji,jj+1,Kmm)) * &
 !                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
 !!gm not this:
-          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
-                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
-                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
-        END DO
-      END DO
-
-      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. )
-
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 
-          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad)
-        END DO
-      END DO
-
-      DO jk = 2, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-            zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-          END DO
-        END DO
-      END DO
-
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zpwes = 0._wp; zpwed = 0._wp
-            zpnss = 0._wp; zpnsd = 0._wp
-            zuijk = zu(ji,jj,jk)
-            zvijk = zv(ji,jj,jk)
-
-            !!!!!     for u equation
-            IF( jk <= mbku(ji,jj) ) THEN
-               IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jis = ji + 1; jid = ji
-               ELSE
-                 jis = ji;     jid = ji +1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
-                 IF( jk1 == mbku(ji,jj) ) THEN
-                   zuijk = -zdept(jis,jj,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
-                 zpwes = zpwes +                                    &
-                      integ_spline(zdept(jis,jj,jk1), zdeps,            &
-                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
-                             csp(jis,jj,jk1),    dsp(jis,jj,jk1))
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)
-                   zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
-                                                     bsp(jid,jj,1),   csp(jid,jj,1), &
-                                                     dsp(jid,jj,1)) * zdeps
-                   zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
-                 zpwed = zpwed +                                        &
-                        integ_spline(zdeps,              zdept(jid,jj,jk1), &
-                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
-                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-               ! update the momentum trends in u direction
-
-               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
-                    &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
-                ELSE
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
-               ENDIF
-               IF( ln_wd_il ) THEN
-                  zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
-                  zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
-               ENDIF
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
-            ENDIF
-
-            !!!!!     for v equation
-            IF( jk <= mbkv(ji,jj) ) THEN
-               IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jjs = jj + 1; jjd = jj
-               ELSE
-                 jjs = jj    ; jjd = jj + 1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
-                 IF( jk1 == mbkv(ji,jj) ) THEN
-                   zvijk = -zdept(ji,jjs,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
-                 zpnss = zpnss +                                      &
-                        integ_spline(zdept(ji,jjs,jk1), zdeps,            &
-                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
-                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)
-                   zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
-                                                     bsp(ji,jjd,1),   csp(ji,jjd,1), &
-                                                     dsp(ji,jjd,1) ) * zdeps
-                   zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
-                 zpnsd = zpnsd +                                        &
-                        integ_spline(zdeps,              zdept(ji,jjd,jk1), &
-                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
-                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-
-               ! update the momentum trends in v direction
-
-               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
-                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
-               ELSE
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
-               ENDIF
-               IF( ln_wd_il ) THEN
-                  zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
-                  zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
-               ENDIF
-
-               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
-            ENDIF
-               !
-            END DO
+       zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * &
+                      & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+       zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * &
+                      & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+      END_2D
+
+      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp )
+
+      DO_2D( 0, 0, 0, 0 )
+       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 
+       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad)
+      END_2D
+
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm)
+      zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm)
+      END_3D
+
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm)
+      zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm)
+      END_3D
+
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+      zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+      zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+      zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+      END_3D
+
+
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      zpwes = 0._wp; zpwed = 0._wp
+      zpnss = 0._wp; zpnsd = 0._wp
+      zuijk = zu(ji,jj,jk)
+      zvijk = zv(ji,jj,jk)
+
+      !!!!!     for u equation
+      IF( jk <= mbku(ji,jj) ) THEN
+         IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
+           jis = ji + 1; jid = ji
+         ELSE
+           jis = ji;     jid = ji +1
+         ENDIF
+
+         ! integrate the pressure on the shallow side
+         jk1 = jk
+         DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
+           IF( jk1 == mbku(ji,jj) ) THEN
+             zuijk = -zdept(jis,jj,jk1)
+             EXIT
+           ENDIF
+           zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
+           zpwes = zpwes +                                    &
+                integ_spline(zdept(jis,jj,jk1), zdeps,            &
+                       asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
+                       csp(jis,jj,jk1),    dsp(jis,jj,jk1))
+           jk1 = jk1 + 1
          END DO
-      END DO
+
+         ! integrate the pressure on the deep side
+         jk1 = jk
+         DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
+           IF( jk1 == 1 ) THEN
+             zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad)
+             zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
+                                               bsp(jid,jj,1),   csp(jid,jj,1), &
+                                               dsp(jid,jj,1)) * zdeps
+             zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
+             EXIT
+           ENDIF
+           zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
+           zpwed = zpwed +                                        &
+                  integ_spline(zdeps,              zdept(jid,jj,jk1), &
+                         asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
+                         csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
+           jk1 = jk1 - 1
+         END DO
+
+         ! update the momentum trends in u direction
+
+         zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+         IF( .NOT.ln_linssh ) THEN
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+              &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) )
+          ELSE
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+         ENDIF
+         IF( ln_wd_il ) THEN
+            zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
+            zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
+         ENDIF
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
+      ENDIF
+
+      !!!!!     for v equation
+      IF( jk <= mbkv(ji,jj) ) THEN
+         IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
+           jjs = jj + 1; jjd = jj
+         ELSE
+           jjs = jj    ; jjd = jj + 1
+         ENDIF
+
+         ! integrate the pressure on the shallow side
+         jk1 = jk
+         DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
+           IF( jk1 == mbkv(ji,jj) ) THEN
+             zvijk = -zdept(ji,jjs,jk1)
+             EXIT
+           ENDIF
+           zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
+           zpnss = zpnss +                                      &
+                  integ_spline(zdept(ji,jjs,jk1), zdeps,            &
+                         asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
+                         csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
+           jk1 = jk1 + 1
+         END DO
+
+         ! integrate the pressure on the deep side
+         jk1 = jk
+         DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
+           IF( jk1 == 1 ) THEN
+             zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad)
+             zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
+                                               bsp(ji,jjd,1),   csp(ji,jjd,1), &
+                                               dsp(ji,jjd,1) ) * zdeps
+             zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
+             EXIT
+           ENDIF
+           zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
+           zpnsd = zpnsd +                                        &
+                  integ_spline(zdeps,              zdept(ji,jjd,jk1), &
+                         asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
+                         csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
+           jk1 = jk1 - 1
+         END DO
+
+
+         ! update the momentum trends in v direction
+
+         zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
+         IF( .NOT.ln_linssh ) THEN
+            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
+                    ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) )
+         ELSE
+            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
+         ENDIF
+         IF( ln_wd_il ) THEN
+            zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
+            zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
+         ENDIF
+
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
+      ENDIF
+         !
+      END_3D
       !
       IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy )
@@ -1467 +1369 @@
    !!======================================================================
 END MODULE dynhpg
-

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynkeg.F90

@@ -36 +36 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44 +44 @@
 CONTAINS
 
-   SUBROUTINE dyn_keg( kt, kscheme )
+   SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_keg  ***
@@ -57 +57 @@
       !!              * kscheme = nkeg_HW : Hollingsworth correction following
       !!      Arakawa (2001). The now horizontal kinetic energy is given by:
-      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  )
-      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ]
+      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((u(j+1)+u(j-1))/2)^2  )
+      !!                    + mj-1(  2 * vn^2 + ((v(i+1)+v(i-1))/2)^2  ) ]
       !!      
       !!      Take its horizontal gradient and add it to the general momentum
-      !!      trend (ua,va).
-      !!         ua = ua - 1/e1u di[ zhke ]
-      !!         va = va - 1/e2v dj[ zhke ]
+      !!      trend.
+      !!         u(rhs) = u(rhs) - 1/e1u di[ zhke ]
+      !!         v(rhs) = v(rhs) - 1/e2v dj[ zhke ]
       !!
-      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
+      !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend
       !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing
       !!
@@ -71 +71 @@
       !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index
-      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme 
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kscheme          ! =0/1   type of KEG scheme 
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
-      INTEGER  ::   ji, jj, jk, jb           ! dummy loop indices
-      INTEGER  ::   ifu, ifv, igrd, ib_bdy   ! local integers
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
       REAL(wp) ::   zu, zv                   ! local scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
-      REAL(wp)  :: zweightu, zweightv
       !!----------------------------------------------------------------------
       !
@@ -92 +92 @@
       IF( l_trddyn ) THEN           ! Save the input trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
       
@@ -101 +101 @@
       !
       CASE ( nkeg_C2 )                          !--  Standard scheme  --!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
-                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
-                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
-                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
-               END DO  
-            END DO
-         END DO
-         !
-         IF (ln_bdy) THEN
-            ! Maria Luneva & Fred Wobus: July-2016
-            ! compensate for lack of turbulent kinetic energy on liquid bdy points
-            DO ib_bdy = 1, nb_bdy
-               IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
-                  igrd = 1           ! compensating null velocity on the bdy
-                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 2 to jpi-1
-                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 2 to jpj-1
-                     DO jk = 1, jpkm1
-                        zhke(ji,jj,jk) = 0._wp
-                        zweightu = umask(ji-1,jj  ,jk) + umask(ji,jj,jk)
-                        zweightv = vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)
-                        zu = un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)  +  un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
-                        zv = vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  +  vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
-                        IF( zweightu > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) + zu / (2._wp * zweightu) 
-                        IF( zweightv > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) + zv / (2._wp * zweightv) 
-                     END DO
-                  END DO
-               END IF
-               CALL lbc_bdy_lnk( 'dynkeg', zhke, 'T', 1., ib_bdy )   ! send 2 and recv jpi, jpj used in the computation of the speed tendencies
-            END DO
-         END IF
-         !
+         DO_3D( 0, 1, 0, 1, 1, jpkm1 )
+            zu =    puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)   &
+               &  + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm)
+            zv =    pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)   &
+               &  + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm)
+            zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
+         END_3D
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1       
-               DO ji = fs_2, jpim1   ! vector opt.
-                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
-                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
-                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
-                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
-                     !
-                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
-                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
-                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
-                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
-                  zhke(ji,jj,jk) = r1_48 * ( zv + zu )
-               END DO  
-            END DO
-         END DO
-         IF (ln_bdy) THEN
-            ! Maria Luneva & Fred Wobus: July-2016
-            ! compensate for lack of turbulent kinetic energy on liquid bdy points
-            DO ib_bdy = 1, nb_bdy
-               IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
-                  igrd = 1           ! compensation null velocity on land at the bdy
-                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 2 to jpi-1
-                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 2 to jpj-1
-                     DO jk = 1, jpkm1
-                        zhke(ji,jj,jk) = 0._wp
-                        zweightu = 8._wp * ( umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) ) &
-                             &   + 2._wp * ( umask(ji-1,jj-1,jk) + umask(ji-1,jj+1,jk) + umask(ji  ,jj-1,jk) + umask(ji  ,jj+1,jk) ) 
-                        zweightv = 8._wp * ( vmask(ji  ,jj-1,jk) + vmask(ji  ,jj-1,jk) ) &
-                             &   + 2._wp * ( vmask(ji-1,jj-1,jk) + vmask(ji+1,jj-1,jk) + vmask(ji-1,jj  ,jk) + vmask(ji+1,jj  ,jk) )
-                        zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
-                           &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
-                           &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
-                           &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
-                        zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
-                           &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
-                           &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
-                           &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
-                        IF( zweightu > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) +  zu / ( 2._wp * zweightu )
-                        IF( zweightv > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) +  zv / ( 2._wp * zweightv )
-                     END DO
-                  END DO
-               END IF
-            END DO
-         END IF
-         CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. )
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    &
+               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  &
+               &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   &
+               &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
+               !
+            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    &
+               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  &
+               &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   &
+               &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
+            zhke(ji,jj,jk) = r1_48 * ( zv + zu )
+         END_3D
+         CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp )
          !
       END SELECT 
       !
-      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
-            END DO 
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
+      END_3D
       !
       IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_keg')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynldf.F90

@@ -34 +34 @@
    PUBLIC   dyn_ldf_init  ! called by opa  module 
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -43 +41 @@
 CONTAINS
 
-   SUBROUTINE dyn_ldf( kt )
+   SUBROUTINE dyn_ldf( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_ldf  ***
@@ -49 +47 @@
       !! ** Purpose :   compute the lateral ocean dynamics physics.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
@@ -58 +58 @@
       IF( l_trddyn )   THEN                      ! temporary save of momentum trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
 
       SELECT CASE ( nldf_dyn )                   ! compute lateral mixing trend and add it to the general trend
       !
-      CASE ( np_lap   )    ;   CALL dyn_ldf_lap( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian
-      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso( kt )                         ! rotated      laplacian
-      CASE ( np_blp   )    ;   CALL dyn_ldf_blp( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian
+      CASE ( np_lap   )  
+         CALL dyn_ldf_lap( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs), 1 ) ! iso-level    laplacian
+      CASE ( np_lap_i ) 
+         CALL dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs    )                                                   ! rotated      laplacian
+      CASE ( np_blp   )  
+         CALL dyn_ldf_blp( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs)    ) ! iso-level bi-laplacian
       !
       END SELECT
 
       IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt, Kmm )
          DEALLOCATE ( ztrdu , ztrdv )
       ENDIF
       !                                          ! print sum trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldf  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_ldf')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynldf_iso.F90

@@ -41 +41 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -60 +61 @@
 
 
-   SUBROUTINE dyn_ldf_iso( kt )
+   SUBROUTINE dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dyn_ldf_iso  ***
@@ -81 +82 @@
       !!      horizontal fluxes associated with the rotated lateral mixing:
       !!      u-component:
-      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ]
-      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
-      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
-      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ uu ]
+      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(uu)) ]
+      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ uu ]
+      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(uu)) ]
       !!      v-component:
-      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ]
-      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ]
-      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
-      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vv ]
+      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vv)) ]
+      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ vv ]
+      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vv)) ]
       !!      take the horizontal divergence of the fluxes:
       !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  }
       !!         diffv = 1/(e1v*e2v*e3v) {  di-1[ zivf ] + dj  [ zjvt ]  }
-      !!      Add this trend to the general trend (ua,va):
-      !!         ua = ua + diffu
+      !!      Add this trend to the general trend (uu(rhs),vv(rhs)):
+      !!         uu(rhs) = uu(rhs) + diffu
       !!      CAUTION: here the isopycnal part is with a coeff. of aht. This
       !!      should be modified for applications others than orca_r2 (!!bug)
       !!
       !! ** Action :
-      !!       -(ua,va) updated with the before geopotential harmonic mixing trend
+      !!       -(puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the before geopotential harmonic mixing trend
       !!       -(akzu,akzv) to accompt for the diagonal vertical component
       !!                    of the rotated operator in dynzdf module
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -125 +128 @@
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
          !
-         DO jk = 1, jpk         ! set the slopes of iso-level
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
-               END DO
-            END DO
-         END DO
+         DO_3D( 0, 0, 0, 0, 1, jpk )
+            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+            wslpi(ji,jj,jk) = - ( gdepw(ji+1,jj,jk,Kbb) - gdepw(ji-1,jj,jk,Kbb) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
+            wslpj(ji,jj,jk) = - ( gdepw(ji,jj+1,jk,Kbb) - gdepw(ji,jj-1,jk,Kbb) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
+         END_3D
          ! Lateral boundary conditions on the slopes
-         CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. )
+         CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp )
          !
        ENDIF
@@ -151 +150 @@
          !                             zdkv(jk=1)=zdkv(jk=2)
 
-         zdk1u(:,:) = ( ub(:,:,jk) -ub(:,:,jk+1) ) * umask(:,:,jk+1)
-         zdk1v(:,:) = ( vb(:,:,jk) -vb(:,:,jk+1) ) * vmask(:,:,jk+1)
+         zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1)
 
          IF( jk == 1 ) THEN
@@ -158 +157 @@
             zdkv(:,:) = zdk1v(:,:)
          ELSE
-            zdku(:,:) = ( ub(:,:,jk-1) - ub(:,:,jk) ) * umask(:,:,jk)
-            zdkv(:,:) = ( vb(:,:,jk-1) - vb(:,:,jk) ) * vmask(:,:,jk)
+            zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk)
+            zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk)
          ENDIF
 
@@ -169 +168 @@
 
          IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj)
-
-                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
-                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
-
-                  zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-   
-                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    &
-                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
-                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 1 )
+               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj)   &
+                  &    * MIN( e3u(ji  ,jj,jk,Kmm),                &
+                  &           e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj)
+
+               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
+                  &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )    &
+                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
+                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj)
-
-                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
-                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
-
-                  zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
-                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
-                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 1 )
+               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b )   &
+                  &     * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj)
+
+               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
+                  &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )   &
+                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ENDIF
 
          ! j-flux at f-point
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj)
-
-               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
-                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
-
-               zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
-
-               zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   &
-                  &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
-                  &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D( 1, 0, 1, 0 )
+            zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b )   &
+               &     * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj)
+
+            zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
+               &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+            zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+            zjuf(ji,jj) = (  zabe2 * ( puu(ji,jj+1,jk,Kbb) - puu(ji,jj,jk,Kbb) )   &
+               &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+               &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk)
+         END_2D
 
          !                                |   t   |
@@ -222 +219 @@
          ! i-flux at f-point              |   t   |
 
-         DO jj = 2, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj)
-
-               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
-                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
-
-               zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    &
-                  &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
-                  &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D( 0, 0, 1, 0 )
+            zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b )   &
+               &     * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj)
+
+            zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
+               &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+            zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+            zivf(ji,jj) = (  zabe1 * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji,jj,jk,Kbb) )    &
+               &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
+               &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
+         END_2D
 
          ! j-flux at t-point
          IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj)
-
-                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
-                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
-
-                  zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    &
-                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
-                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 1, 0 )
+               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj)   &
+                  &     * MIN( e3v(ji,jj  ,jk,Kmm),                 &
+                  &            e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj)
+
+               zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
+                  &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+               zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )    &
+                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
+                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj)
-
-                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
-                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-                  zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
-                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
-                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 1, 0 )
+               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b )   &
+                  &     * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj)
+
+               zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
+                  &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )   &
+                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
+                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ENDIF
 
@@ -273 +268 @@
          ! Second derivative (divergence) and add to the general trend
          ! -----------------------------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
-                  &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
-                  &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
+               &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj)   &
+               &                           / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
+               &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj)   &
+               &                           / e3v(ji,jj,jk,Kmm)
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -286 +281 @@
 
       ! print sum trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldfh - Ua: ', mask1=umask, &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldfh - Ua: ', mask1=umask, &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
 
 
@@ -306 +301 @@
             DO ji = 2, jpi
                ! i-gradient of u at jj
-               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( ub(ji,jj  ,jk) - ub(ji-1,jj  ,jk) )
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) )
                ! j-gradient of u and v at jj
-               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( ub(ji,jj+1,jk) - ub(ji  ,jj  ,jk) )
-               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( vb(ji,jj  ,jk) - vb(ji  ,jj-1,jk) )
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( puu(ji,jj+1,jk,Kbb) - puu(ji  ,jj  ,jk,Kbb) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pvv(ji,jj  ,jk,Kbb) - pvv(ji  ,jj-1,jk,Kbb) )
                ! j-gradient of u and v at jj+1
-               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( ub(ji,jj  ,jk) - ub(ji  ,jj-1,jk) )
-               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( vb(ji,jj+1,jk) - vb(ji  ,jj  ,jk) )
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji  ,jj-1,jk,Kbb) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pvv(ji,jj+1,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) )
             END DO
          END DO
@@ -318 +313 @@
             DO ji = 1, jpim1
                ! i-gradient of v at jj
-               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( vb(ji+1,jj,jk) - vb(ji  ,jj  ,jk) )
+               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) )
             END DO
          END DO
@@ -391 +386 @@
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj)   &
+                  &               / e3u(ji,jj,jk,Kmm)
+               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj)   &
+                  &               / e3v(ji,jj,jk,Kmm)
             END DO
          END DO

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynldf_lap_blp.F90

@@ -27 +27 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -35 +36 @@
 CONTAINS
 
-   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )
+   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dyn_ldf_lap  ***
@@ -45 +46 @@
       !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 
       !!
-      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb.
+      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
       INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -71 +73 @@
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
-!!gm open question here : e3f  at before or now ?    probably now...
-!!gm note that ahmf has already been multiplied by fmask
-               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &
-                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  &
-                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  )
-               !                                      ! ahm * div        (computed from 2 to jpi/jpj)
-!!gm note that ahmt has already been multiplied by tmask
-               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk)                                         &
-                  &     * (  e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  &
-                  &        + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  )
-            END DO  
-         END DO  
+         DO_2D( 0, 1, 0, 1 )
+            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask
+               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  &
+               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  )
+            !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask
+               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  &
+               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  )
+         END_2D
          !
-         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div )
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                 &
-                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)   &
-                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     )
-                  !
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                 &
-                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)   &
-                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     )
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use
+               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   &
+               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      )
+               !
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use
+               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   &
+               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      )
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -105 +100 @@
 
 
-   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva )
+   SUBROUTINE dyn_ldf_blp( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE dyn_ldf_blp  ***
@@ -116 +111 @@
       !!      It is computed by two successive calls to dyn_ldf_lap routine
       !!
-      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !! ** Action :   pt(:,:,:,:,Krhs)   updated with the before rotated bilaplacian diffusion
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend
       !
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point
@@ -134 +130 @@
       zvlap(:,:,:) = 0._wp
       !
-      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap)
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb)
       !
-      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions
+      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions
       !
-      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta)
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs))
       !
    END SUBROUTINE dyn_ldf_blp

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynspg.F90

@@ -21 +21 @@
    USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
    USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
-   USE sbctide        ! 
-   USE updtide        ! 
+   USE tide_mod       !
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
@@ -43 +42 @@
    INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping
    INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme
+   !
+   REAL(wp) ::   zt0step !   Time of day at the beginning of the time step
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -53 +54 @@
 CONTAINS
 
-   SUBROUTINE dyn_spg( kt )
+   SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_spg  ***
@@ -66 +67 @@
       !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
       !!             as the gradient of the inverse barometer ssh:
-      !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
-      !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
-      !!             Note that as all external forcing a time averaging over a two rdt
+      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
+      !!                apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
+      !!             Note that as all external forcing a time averaging over a two rn_Dt
       !!             period is used to prevent the divergence of odd and even time step.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels
       !
       INTEGER  ::   ji, jj, jk                   ! dummy loop indices
-      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r, zld   ! local scalars
+      REAL(wp) ::   z2dt, zg_2, zintp, zgrho0r, zld   ! local scalars
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
@@ -83 +87 @@
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
@@ -91 +95 @@
          .OR.  ln_ice_embd ) THEN                                            ! embedded sea-ice
          !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = 0._wp
-               spgv(ji,jj) = 0._wp
-            END DO
-         END DO         
+         DO_2D( 0, 0, 0, 0 )
+            spgu(ji,jj) = 0._wp
+            spgv(ji,jj) = 0._wp
+         END_2D
          !
          IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==!
             zg_2 = grav * 0.5
-            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
-                     &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
-                     &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
+                  &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
+                  &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF
          !
@@ -113 +113 @@
          IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case
             !
-            CALL upd_tide( kt )                      ! update tide potential
+            ! Update tide potential at the beginning of current time step
+            zt0step = REAL(nsec_day, wp)-0.5_wp*rn_Dt
+            CALL upd_tide(zt0step, Kmm)
             !
-            DO jj = 2, jpjm1                         ! add tide potential forcing
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-               END DO 
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
             !
             IF (ln_scal_load) THEN
                zld = rn_scal_load * grav
-               DO jj = 2, jpjm1                    ! add scalar approximation for load potential
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
-                     spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
-                  END DO 
-               END DO
+               DO_2D( 0, 0, 0, 0 )
+                  spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj)
+               END_2D
             ENDIF
          ENDIF
@@ -136 +134 @@
             ALLOCATE( zpice(jpi,jpj) )
             zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
-            zgrau0r     = - grav * r1_rau0
-            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            zgrho0r     = - grav * r1_rho0
+            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrho0r
+            DO_2D( 0, 0, 0, 0 )
+               spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
             DEALLOCATE( zpice )         
          ENDIF
          !
-         DO jk = 1, jpkm1                    !== Add all terms to the general trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
-                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
-               END DO
-            END DO
-         END DO    
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj)
+         END_3D
          !
 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ????
@@ -161 +153 @@
       !
       SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==!
-      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit
-      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
+      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt,      Kmm,       puu, pvv, Krhs )                    ! explicit
+      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting
       END SELECT
       !                    
       IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv ) 
       ENDIF
       !                                      ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' spg  - Ua: ', mask1=umask, &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_spg')
@@ -191 +183 @@
       NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   &
       &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   &
-      &                    nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha
+      &                    nn_e , rn_bt_cmax, nn_bt_flt, rn_bt_alpha
       !!----------------------------------------------------------------------
       !
@@ -200 +192 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface
       READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist' )
+      !
       READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' )
       IF(lwm) WRITE ( numond, namdyn_spg )
       !
@@ -232 +222 @@
       !
       IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation
-         CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on
+         CALL dyn_spg_ts_init          ! do it first: set nn_e used to allocate some arrays later on
       ENDIF
       !

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynspg_exp.F90

@@ -30 +30 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -38 +38 @@
 CONTAINS
 
-   SUBROUTINE dyn_spg_exp( kt )
+   SUBROUTINE dyn_spg_exp( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  routine dyn_spg_exp  ***
@@ -48 +48 @@
       !! ** Method  :   Explicit free surface formulation. Add to the general
       !!              momentum trend the surface pressure gradient :
-      !!                      (ua,va) = (ua,va) + (spgu,spgv)
-      !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( sshn )
-      !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( sshn )
+      !!                      (uu(rhs),vv(rhs)) = (uu(rhs),vv(rhs)) + (spgu,spgv)
+      !!              where spgu = -1/rho0 d/dx(ps) = -g/e1u di( ssh(now) )
+      !!                    spgv = -1/rho0 d/dy(ps) = -g/e2v dj( ssh(now) )
       !!
-      !! ** Action :   (ua,va)   trend of horizontal velocity increased by 
+      !! ** Action :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs))   trend of horizontal velocity increased by 
       !!                         the surf. pressure gradient trend
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt        ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv  ! ocean velocities and RHS of momentum equation
       !!
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -72 +74 @@
       IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend
          !
-         DO jj = 2, jpjm1                    ! now surface pressure gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
-               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
-            END DO 
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj)
+            spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj)
+         END_2D
          !
-         DO jk = 1, jpkm1                    ! Add it to the general trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
-                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj)
+         END_3D
          !
       ENDIF

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynspg_ts.F90

@@ -1 +1 @@
 MODULE dynspg_ts
 
-   !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out ! 
+   !! Includes ROMS wd scheme with diagnostic outputs ; puu(:,:,:,Kmm) and puu(:,:,:,Krhs) updates are commented out ! 
 
    !!======================================================================
@@ -31 +31 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition: ocean
+   USE isf_oce         ! ice shelf variable (fwfisf)
    USE zdf_oce         ! vertical physics: variables
    USE zdfdrg          ! vertical physics: top/bottom drag coef.
-   USE sbcisf          ! ice shelf variable (fwfisf)
    USE sbcapr          ! surface boundary condition: atmospheric pressure
    USE dynadv    , ONLY: ln_dynadv_vec
@@ -44 +44 @@
    USE bdytides        ! open boundary condition data
    USE bdydyn2d        ! open boundary conditions on barotropic variables
-   USE sbctide         ! tides
-   USE updtide         ! tide potential
+   USE tide_mod        !
    USE sbcwave         ! surface wave
-   USE diatmb          ! Top,middle,bottom output
 #if defined key_agrif
    USE agrif_oce_interp ! agrif
@@ -62 +60 @@
    USE iom             ! IOM library
    USE restart         ! only for lrst_oce
-   USE diatmb          ! Top,middle,bottom output
+
+   USE iom   ! to remove
 
    IMPLICIT NONE
@@ -73 +72 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv   !: Advection vel. at "now" barocl. step
    !
-   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
-   REAL(wp),SAVE :: rdtbt       ! Barotropic time step
+   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_e <= 2.5 nn_e
+   REAL(wp),SAVE :: rDt_e       ! Barotropic time step
    !
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
@@ -87 +86 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -103 +103 @@
       ierr(:) = 0
       !
-      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
-      !
+      ALLOCATE( wgtbtp1(3*nn_e), wgtbtp2(3*nn_e), zwz(jpi,jpj), STAT=ierr(1) )
       IF( ln_dynvor_een .OR. ln_dynvor_eeT )   &
-         &     ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
-         &               ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(2) )
+         &     ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , ftsw(jpi,jpj) , ftse(jpi,jpj), STAT=ierr(2)   )
          !
       ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) )
@@ -119 +117 @@
 
 
-   SUBROUTINE dyn_spg_ts( kt )
+   SUBROUTINE dyn_spg_ts( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
       !!----------------------------------------------------------------------
       !!
@@ -134 +132 @@
       !!
       !! ** Action :
-      !!      -Update the filtered free surface at step "n+1"      : ssha
-      !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b
+      !!      -Update the filtered free surface at step "n+1"      : pssh(:,:,Kaa)
+      !!      -Update filtered barotropic velocities at step "n+1" : puu_b(:,:,:,Kaa), vv_b(:,:,:,Kaa)
       !!      -Compute barotropic advective fluxes at step "n"     : un_adv, vn_adv
       !!      These are used to advect tracers and are compliant with discrete
       !!      continuity equation taken at the baroclinic time steps. This 
       !!      ensures tracers conservation.
-      !!      - (ua, va) momentum trend updated with barotropic component.
+      !!      - (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) momentum trend updated with barotropic component.
       !!
       !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels
       !
       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices
       LOGICAL  ::   ll_fw_start           ! =T : forward integration 
       LOGICAL  ::   ll_init               ! =T : special startup of 2d equations
-      LOGICAL  ::   ll_tmp1, ll_tmp2      ! local logical variables used in W/D
-      INTEGER  ::   ikbu, iktu, noffset   ! local integers
-      INTEGER  ::   ikbv, iktv            !   -      -
-      REAL(wp) ::   r1_2dt_b, z2dt_bf               ! local scalars
-      REAL(wp) ::   zx1, zx2, zu_spg, zhura, z1_hu  !   -      -
-      REAL(wp) ::   zy1, zy2, zv_spg, zhvra, z1_hv  !   -      -
+      INTEGER  ::   noffset               ! local integers  : time offset for bdy update
+      REAL(wp) ::   r1_Dt_b, z1_hu, z1_hv          ! local scalars
       REAL(wp) ::   za0, za1, za2, za3              !   -      -
-      REAL(wp) ::   zmdi, zztmp            , z1_ht  !   -      -
-      REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf
-      REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc
-      REAL(wp), DIMENSION(jpi,jpj) :: zwy, zv_trd, zv_frc, zhdiv
-      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhust_e, zhtp2_e
-      REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zhvst_e
+      REAL(wp) ::   zztmp, zldg               !   -      -
+      REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      -
+      REAL(wp) ::   zun_save, zvn_save              !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc
+      REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg
+      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e
+      REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e
       REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points
+      REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV         ! fluxes
+      REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v
       !
       REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_wd_dl = .True. 
@@ -172 +172 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask
+      REAL(wp) ::   zt0substep !   Time of day at the beginning of the time substep
       !!----------------------------------------------------------------------
       !
@@ -178 +179 @@
       IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj))
       !
-      zmdi=1.e+20                               !  missing data indicator for masking
-      !
       zwdramp = r_rn_wdmin1               ! simplest ramp 
 !     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp
-      !                                         ! reciprocal of baroclinic time step 
-      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
-      ELSE                                        ;   z2dt_bf = 2.0_wp * rdt
-      ENDIF
-      r1_2dt_b = 1.0_wp / z2dt_bf 
+      !                                         ! inverse of baroclinic time step 
+      r1_Dt_b = 1._wp / rDt 
       !
       ll_init     = ln_bt_av                    ! if no time averaging, then no specific restart 
       ll_fw_start = .FALSE.
       !                                         ! time offset in steps for bdy data update
-      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro
+      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_e
       ELSE                       ;   noffset =   0 
       ENDIF
@@ -202 +198 @@
          IF(lwp) WRITE(numout,*)
          !
-         IF( neuler == 0 )   ll_init=.TRUE.
-         !
-         IF( ln_bt_fw .OR. neuler == 0 ) THEN
+         IF( l_1st_euler )   ll_init=.TRUE.
+         !
+         IF( ln_bt_fw .OR. l_1st_euler ) THEN
             ll_fw_start =.TRUE.
             noffset     = 0
@@ -210 +206 @@
             ll_fw_start =.FALSE.
          ENDIF
-         !
-         ! Set averaging weights and cycle length:
+         !                    ! Set averaging weights and cycle length:
          CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
          !
-      ENDIF
-      !
-      IF( ln_isfcav ) THEN    ! top+bottom friction (ocean cavities)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
-               zCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
-            END DO
-         END DO
-      ELSE                    ! bottom friction only
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
-               zCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
-            END DO
-         END DO
-      ENDIF
-      !
-      ! Set arrays to remove/compute coriolis trend.
-      ! Do it once at kt=nit000 if volume is fixed, else at each long time step.
-      ! Note that these arrays are also used during barotropic loop. These are however frozen
-      ! although they should be updated in the variable volume case. Not a big approximation.
-      ! To remove this approximation, copy lines below inside barotropic loop
-      ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step
-      !
-      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN
-         !
-         SELECT CASE( nvor_scheme )
-         CASE( np_EEN )                != EEN scheme using e3f (energy & enstrophy scheme)
-            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
-            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
-                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
-                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-                  END DO
-               END DO
-            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
-                        &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   &
-                        &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
-                        &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
-                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-                  END DO
-               END DO
-            END SELECT
-            CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp )
-            !
-            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-               END DO
-            END DO
-            !
-         CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme)
-            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) )
-                  ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
-                  ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
-                  ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
-                  ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
-               END DO
-            END DO
-            !
-         CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT !
-            !
-            zwz(:,:) = 0._wp
-            zhf(:,:) = 0._wp
-            
-!!gm  assume 0 in both cases (which is almost surely WRONG ! ) as hvatf has been removed 
-!!gm    A priori a better value should be something like :
-!!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1) 
-!!gm                     divided by the sum of the corresponding mask 
-!!gm 
-!!            
-            IF( .NOT.ln_sco ) THEN
-  
-   !!gm  agree the JC comment  : this should be done in a much clear way
-  
-   ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
-   !     Set it to zero for the time being 
-   !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level
-   !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
-   !              ENDIF
-   !              zhf(:,:) = gdepw_0(:,:,jk+1)
-               !
-            ELSE
-               !
-               !zhf(:,:) = hbatf(:,:)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
-                        &              + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
-                        &       / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
-                        &              + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
-                  END DO
-               END DO
-            ENDIF
-            !
-            DO jj = 1, jpjm1
-               zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
-            END DO
-            !
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )
-            ! JC: TBC. hf should be greater than 0 
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array
-               END DO
-            END DO
-            zwz(:,:) = ff_f(:,:) * zwz(:,:)
-         END SELECT
-      ENDIF
-      !
-      ! If forward start at previous time step, and centered integration, 
-      ! then update averaging weights:
-      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
-         ll_fw_start=.FALSE.
-         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
-      ENDIF
-                          
+      ELSEIF( kt == nit000 + 1 ) THEN           !* initialisation 2nd time-step
+         !
+         IF( .NOT.ln_bt_fw ) THEN
+            ! If we did an Euler timestep on the first timestep we need to reset ll_fw_start
+            ! and the averaging weights. We don't have an easy way of telling whether we did
+            ! an Euler timestep on the first timestep (because l_1st_euler is reset to .false.
+            ! at the end of the first timestep) so just do this in all cases. 
+            ll_fw_start = .FALSE.
+            CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
+         ENDIF
+         !
+      ENDIF
+      !
       ! -----------------------------------------------------------------------------
       !  Phase 1 : Coupling between general trend and barotropic estimates (1st step)
@@ -354 +227 @@
       !      
       !
-      !                                   !* e3*d/dt(Ua) (Vertically integrated)
-      !                                   ! --------------------------------------------------
-      zu_frc(:,:) = 0._wp
-      zv_frc(:,:) = 0._wp
-      !
-      DO jk = 1, jpkm1
-         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)         
+      !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends)
+      !                                   !  ---------------------------  !
+      DO jk = 1 , jpk
+         ze3u(:,:,jk) = e3u(:,:,jk,Kmm)
+         ze3v(:,:,jk) = e3v(:,:,jk,Kmm)
       END DO
       !
-      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:)
-      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:)
-      !
-      !
-      !                                   !* baroclinic momentum trend (remove the vertical mean trend)
-      DO jk = 1, jpkm1                    ! -----------------------------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - zu_frc(ji,jj) * umask(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - zv_frc(ji,jj) * vmask(ji,jj,jk)
-            END DO
-         END DO
+      zu_frc(:,:) = SUM( ze3u(:,:,:) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm)
+      zv_frc(:,:) = SUM( ze3v(:,:,:) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm)
+      !
+      !
+      !                                   !=  U(Krhs) => baroclinic trend  =!   (remove its vertical mean)
+      DO jk = 1, jpkm1                    !  -----------------------------  !
+         uu(:,:,jk,Krhs) = ( uu(:,:,jk,Krhs) - zu_frc(:,:) ) * umask(:,:,jk)
+         vv(:,:,jk,Krhs) = ( vv(:,:,jk,Krhs) - zv_frc(:,:) ) * vmask(:,:,jk)
       END DO
       
@@ -381 +247 @@
 !!gm  Is it correct to do so ?   I think so...
       
-      
-      !                                   !* barotropic Coriolis trends (vorticity scheme dependent)
-      !                                   ! --------------------------------------------------------
-      !
-      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
-      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)
-      !
-      SELECT CASE( nvor_scheme )
-      CASE( np_ENT )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj)                    &
-                  &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   &
-                  &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   )
-                  !
-               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj)                    &
-                  &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   & 
-                  &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   ) 
-            END DO  
-         END DO  
-         !         
-      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               ! energy conserving formulation for planetary vorticity term
-               zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-            END DO
-         END DO
-         !
-      CASE( np_ENS )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 =   r1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = - r1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO
-         END DO
-         !
-      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)         
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
-                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
-                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
-                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      !                                   !* Right-Hand-Side of the barotropic momentum equation
-      !                                   ! ----------------------------------------------------
-      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient
-         IF( ln_wd_il ) THEN                        ! Calculating and applying W/D gravity filters
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1 
-                  ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
-                     &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
-                     &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                     &                                                         > rn_wdmin1 + rn_wdmin2
-                  ll_tmp2 = ( ABS( sshn(ji+1,jj)            -  sshn(ji  ,jj))  > 1.E-12 ).AND.( &
-                     &      MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                     &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-                  IF(ll_tmp1) THEN
-                     zcpx(ji,jj) = 1.0_wp
-                  ELSEIF(ll_tmp2) THEN
-                     ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-                     zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                                 &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-                     zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-                  ELSE
-                     zcpx(ji,jj) = 0._wp
-                  ENDIF
-                  !
-                  ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji,jj+1) ) >                &
-                     &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
-                     &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                     &                                                       > rn_wdmin1 + rn_wdmin2
-                  ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji,jj+1))  > 1.E-12 ).AND.( &
-                     &      MAX(   sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                     &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-  
-                  IF(ll_tmp1) THEN
-                     zcpy(ji,jj) = 1.0_wp
-                  ELSE IF(ll_tmp2) THEN
-                     ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-                     zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                        &             / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-                     zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
-                  ELSE
-                     zcpy(ji,jj) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-            !
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
-               END DO
-            END DO
-            !
-         ELSE
-            !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
-               END DO
-            END DO
-         ENDIF
-         !
-      ENDIF
-      !
-      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
-         DO ji = fs_2, fs_jpim1
-             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
-             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
-          END DO
-      END DO 
-      !
-      !                                         ! Add bottom stress contribution from baroclinic velocities:      
-      IF (ln_bt_fw) THEN
-         DO jj = 2, jpjm1                          
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zwx(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj) ! NOW bottom baroclinic velocities
-               zwy(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj)
-            END DO
-         END DO
+      !                                   !=  remove 2D Coriolis and pressure gradient trends  =!
+      !                                   !  -------------------------------------------------  !
+      !
+      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init( Kmm )   ! Set zwz, the barotropic Coriolis force coefficient
+      !       ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes
+      !
+      !                                         !* 2D Coriolis trends
+      zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:)        ! now fluxes 
+      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column
+      !
+      CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in
+         &                                                                     zu_trd, zv_trd   )   ! ==>> out
+      !
+      IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only)
+         !
+         IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg
+            CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy
+            DO_2D( 0, 0, 0, 0 )
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj ,Kmm) )   &
+                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj ,Kmm) )   &
+                  &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
+            END_2D
+         ELSE                                      ! now suface pressure gradient
+            DO_2D( 0, 0, 0, 0 )
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e2v(ji,jj) 
+            END_2D
+         ENDIF
+         !
+      ENDIF
+      !
+      DO_2D( 0, 0, 0, 0 )
+          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
+      END_2D
+      !
+      !                                   !=  Add bottom stress contribution from baroclinic velocities  =!
+      !                                   !  -----------------------------------------------------------  !
+      CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
+      !                                   !=  Add atmospheric pressure forcing  =!
+      !                                   !  ----------------------------------  !
+      IF( ln_apr_dyn ) THEN
+         IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2)
+            DO_2D( 0, 0, 0, 0 )
+               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
+         ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW)
+            zztmp = grav * r1_2
+            DO_2D( 0, 0, 0, 0 )
+               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+            END_2D
+         ENDIF
+      ENDIF
+      !
+      !                                   !=  Add atmospheric pressure forcing  =!
+      !                                   !  ----------------------------------  !
+      IF( ln_bt_fw ) THEN                        ! Add wind forcing
+         DO_2D( 0, 0, 0, 0 )
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm)
+         END_2D
       ELSE
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zwx(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj) ! BEFORE bottom baroclinic velocities
-               zwy(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
-      IF( ln_wd_il ) THEN
-         zztmp = -1._wp / rdtbt
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) = zu_frc(ji,jj) + & 
-               & MAX(r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ), zztmp ) * zwx(ji,jj) *  wdrampu(ji,jj)
-               zv_frc(ji,jj) = zv_frc(ji,jj) + & 
-               & MAX(r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ), zztmp ) * zwy(ji,jj) *  wdrampv(ji,jj)
-            END DO
-         END DO
-      ELSE
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj)
-               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj)
-            END DO
-         END DO
+         zztmp = r1_rho0 * r1_2
+         DO_2D( 0, 0, 0, 0 )
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm)
+         END_2D
+      ENDIF  
+      !
+      !              !----------------!
+      !              !==  sssh_frc  ==!   Right-Hand-Side of the barotropic ssh equation   (over the FULL domain)
+      !              !----------------!
+      !                                   !=  Net water flux forcing applied to a water column  =!
+      !                                   ! ---------------------------------------------------  !
+      IF (ln_bt_fw) THEN                          ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
+         zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) )
+      ELSE                                        ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW)
+         zztmp = r1_rho0 * r1_2
+         zssh_frc(:,:) = zztmp * (  emp(:,:)        + emp_b(:,:)                    &
+                &                 - rnf(:,:)        - rnf_b(:,:)                    &
+                &                 + fwfisf_cav(:,:) + fwfisf_cav_b(:,:)             &
+                &                 + fwfisf_par(:,:) + fwfisf_par_b(:,:)             )
+      ENDIF
+      !                                   !=  Add Stokes drift divergence  =!   (if exist)
+      IF( ln_sdw ) THEN                   !  -----------------------------  !
+         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
+      ENDIF
+      !
+      !                                         ! ice sheet coupling
+      IF ( ln_isf .AND. ln_isfcpl ) THEN
+         !
+         ! ice sheet coupling
+         IF( ln_rstart .AND. kt == nit000 ) THEN
+            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_ssh(:,:)
+         END IF
+         !
+         ! conservation option
+         IF( ln_isfcpl_cons ) THEN
+            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_cons_ssh(:,:)
+         END IF
+         !
       END IF
       !
-      IF( ln_isfcav ) THEN       ! Add TOP stress contribution from baroclinic velocities:      
-         IF( ln_bt_fw ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
-                  zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
-               END DO
-            END DO
-         ELSE
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
-                  zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Note that the "unclipped" top friction parameter is used even with explicit drag
-         DO jj = 2, jpjm1              
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj)
-               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !       
-      IF( ln_bt_fw ) THEN                        ! Add wind forcing
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj)
-            END DO
-         END DO
-      ELSE
-         zztmp = r1_rau0 * r1_2
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj)
-            END DO
-         END DO
-      ENDIF  
-      !
-      IF( ln_apr_dyn ) THEN                     ! Add atm pressure forcing
-         IF( ln_bt_fw ) THEN
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
-                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
-               END DO
-            END DO
-         ELSE
-            zztmp = grav * r1_2
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg = zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
-                      &             + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  zv_spg = zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
-                      &             + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
-               END DO
-            END DO
-         ENDIF 
-      ENDIF
-      !                                   !* Right-Hand-Side of the barotropic ssh equation
-      !                                   ! -----------------------------------------------
-      !                                         ! Surface net water flux and rivers
-      IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
-      ELSE
-         zztmp = r1_rau0 * r1_2
-         zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
-                &                 + fwfisf(:,:) + fwfisf_b(:,:)                     )
-      ENDIF
-      !
-      IF( ln_sdw ) THEN                         ! Stokes drift divergence added if necessary
-         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
-      ENDIF
-      !
 #if defined key_asminc
-      !                                         ! Include the IAU weighted SSH increment
+      !                                   !=  Add the IAU weighted SSH increment  =!
+      !                                   !  ------------------------------------  !
       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
          zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
       ENDIF
 #endif
-      !                                   !* Fill boundary data arrays for AGRIF
+      !                                   != Fill boundary data arrays for AGRIF
       !                                   ! ------------------------------------
 #if defined key_agrif
@@ -671 +384 @@
          vb_e   (:,:) = 0._wp
       ENDIF
-
+      !
+      IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0)
+         zhup2_e(:,:) = hu(:,:,Kmm)
+         zhvp2_e(:,:) = hv(:,:,Kmm)
+         zhtp2_e(:,:) = ht(:,:)
+      ENDIF
       !
       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
-         sshn_e(:,:) =    sshn(:,:)            
-         un_e  (:,:) =    un_b(:,:)            
-         vn_e  (:,:) =    vn_b(:,:)
-         !
-         hu_e  (:,:) =    hu_n(:,:)       
-         hv_e  (:,:) =    hv_n(:,:) 
-         hur_e (:,:) = r1_hu_n(:,:)    
-         hvr_e (:,:) = r1_hv_n(:,:)
+         sshn_e(:,:) =    pssh(:,:,Kmm)            
+         un_e  (:,:) =    puu_b(:,:,Kmm)            
+         vn_e  (:,:) =    pvv_b(:,:,Kmm)
+         !
+         hu_e  (:,:) =    hu(:,:,Kmm)       
+         hv_e  (:,:) =    hv(:,:,Kmm) 
+         hur_e (:,:) = r1_hu(:,:,Kmm)    
+         hvr_e (:,:) = r1_hv(:,:,Kmm)
       ELSE                                ! CENTRED integration: start from BEFORE fields
-         sshn_e(:,:) =    sshb(:,:)
-         un_e  (:,:) =    ub_b(:,:)         
-         vn_e  (:,:) =    vb_b(:,:)
-         !
-         hu_e  (:,:) =    hu_b(:,:)       
-         hv_e  (:,:) =    hv_b(:,:) 
-         hur_e (:,:) = r1_hu_b(:,:)    
-         hvr_e (:,:) = r1_hv_b(:,:)
-      ENDIF
-      !
-      !
+         sshn_e(:,:) =    pssh(:,:,Kbb)
+         un_e  (:,:) =    puu_b(:,:,Kbb)         
+         vn_e  (:,:) =    pvv_b(:,:,Kbb)
+         !
+         hu_e  (:,:) =    hu(:,:,Kbb)       
+         hv_e  (:,:) =    hv(:,:,Kbb) 
+         hur_e (:,:) = r1_hu(:,:,Kbb)    
+         hvr_e (:,:) = r1_hv(:,:,Kbb)
+      ENDIF
       !
       ! Initialize sums:
-      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)          
-      va_b  (:,:) = 0._wp
-      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level
+      puu_b  (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)          
+      pvv_b  (:,:,Kaa) = 0._wp
+      pssh  (:,:,Kaa) = 0._wp       ! Sum for after averaged sea level
       un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop
       vn_adv(:,:) = 0._wp
@@ -714 +430 @@
          !
          l_full_nf_update = jn == icycle   ! false: disable full North fold update (performances) for jn = 1 to icycle-1
-         !                                                !  ------------------
-         !                                                !* Update the forcing (BDY and tides)
-         !                                                !  ------------------
-         ! Update only tidal forcing at open boundaries
-         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 )
-         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, time_offset= noffset   )
-         !
-         ! Set extrapolation coefficients for predictor step:
+         !
+         !                    !==  Update the forcing ==! (BDY and tides)
+         !
+         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, pt_offset= REAL(noffset+1,wp) )
+         ! Update tide potential at the beginning of current time substep
+         IF( ln_tide_pot .AND. ln_tide ) THEN
+            zt0substep = REAL(nsec_day, wp) - 0.5_wp*rn_Dt + (jn + noffset - 1) * rn_Dt / REAL(nn_e, wp)
+            CALL upd_tide(zt0substep, Kmm)
+         END IF
+         !
+         !                    !==  extrapolation at mid-step  ==!   (jn+1/2)
+         !
+         !                       !* Set extrapolation coefficients for predictor step:
          IF ((jn<3).AND.ll_init) THEN      ! Forward           
            za1 = 1._wp                                          
@@ -731 +452 @@
            za3 =  0.281105_wp              ! za3 = bet
          ENDIF
-
-         ! Extrapolate barotropic velocities at step jit+0.5:
+         !
+         !                       !* Extrapolate barotropic velocities at mid-step (jn+1/2)
+         !--        m+1/2               m                m-1           m-2       --!
+         !--       u      = (3/2+beta) u   -(1/2+2beta) u      + beta u          --!
+         !-------------------------------------------------------------------------!
          ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
          va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
@@ -739 +463 @@
             !                                             !  ------------------
             ! Extrapolate Sea Level at step jit+0.5:
+            !--         m+1/2                 m                  m-1             m-2       --!
+            !--      ssh      = (3/2+beta) ssh   -(1/2+2beta) ssh      + beta ssh          --!
+            !--------------------------------------------------------------------------------!
             zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:)
             
-            ! set wetting & drying mask at tracer points for this barotropic sub-step 
-            IF ( ln_wd_dl ) THEN 
-               !
-               IF ( ln_wd_dl_rmp ) THEN 
-                  DO jj = 1, jpj                                 
-                     DO ji = 1, jpi   ! vector opt.  
-                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
-!                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin2 ) THEN 
-                           ztwdmask(ji,jj) = 1._wp
-                        ELSE IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
-                           ztwdmask(ji,jj) = (tanh(50._wp*( ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1)) ) 
-                        ELSE 
-                           ztwdmask(ji,jj) = 0._wp
-                        END IF
-                     END DO
-                  END DO
-               ELSE
-                  DO jj = 1, jpj                                 
-                     DO ji = 1, jpi   ! vector opt.  
-                        IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
-                           ztwdmask(ji,jj) = 1._wp
-                        ELSE 
-                           ztwdmask(ji,jj) = 0._wp
-                        ENDIF
-                     END DO
-                  END DO
-               ENDIF 
-               !
-            ENDIF 
+            ! set wetting & drying mask at tracer points for this barotropic mid-step
+            IF( ln_wd_dl )   CALL wad_tmsk( zsshp2_e, ztwdmask )
             !
-            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
-               DO ji = 2, fs_jpim1   ! Vector opt.
-                  zwx(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
-                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
-                  zwy(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
-                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk_multi( 'dynspg_ts', zwx, 'U', 1._wp, zwy, 'V', 1._wp )
+            !                          ! ocean t-depth at mid-step
+            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:)
             !
-            zhup2_e(:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points
-            zhvp2_e(:,:) = hv_0(:,:) + zwy(:,:)
-            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:)
-         ELSE
-            zhup2_e(:,:) = hu_n(:,:)
-            zhvp2_e(:,:) = hv_n(:,:)
-            zhtp2_e(:,:) = ht_n(:,:)
-         ENDIF
-         !                                                !* after ssh
-         !                                                !  -----------
-         !
-         ! Enforce volume conservation at open boundaries:
+            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk)
+            DO_2D( 1, 1, 1, 0 )
+               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
+                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+            END_2D
+            DO_2D( 1, 0, 1, 1 )
+               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
+                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+            END_2D
+            !
+         ENDIF
+         !
+         !                    !==  after SSH  ==!   (jn+1)
+         !
+         !                             ! update (ua_e,va_e) to enforce volume conservation at open boundaries
+         !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d
          IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e )
-         !
-         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5
-         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
+         !      
+         !                             ! resulting flux at mid-step (not over the full domain)
+         zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column
+         zhV(1:jpi  ,1:jpjm1) = e1v(1:jpi  ,1:jpjm1) * va_e(1:jpi  ,1:jpjm1) * zhvp2_e(1:jpi  ,1:jpjm1)   ! not jpj-row
          !
 #if defined key_agrif
          ! Set fluxes during predictor step to ensure volume conservation
-         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
-            IF((nbondi == -1).OR.(nbondi == 2)) THEN
-               DO jj = 1, jpj
-                  zwx(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj)
-                  zwy(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * e1v(2:nbghostcells+1,jj)
-               END DO
-            ENDIF
-            IF((nbondi ==  1).OR.(nbondi == 2)) THEN
-               DO jj=1,jpj
-                  zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj)
-                  zwy(nlci-nbghostcells  :nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * e1v(nlci-nbghostcells  :nlci-1,jj)
-               END DO
-            ENDIF
-            IF((nbondj == -1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zwy(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1)
-                  zwx(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * e2u(ji,2:nbghostcells+1)
-               END DO
-            ENDIF
-            IF((nbondj ==  1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2)
-                  zwx(ji,nlcj-nbghostcells  :nlcj-1) = ubdy_n(ji,1:nbghostcells) * e2u(ji,nlcj-nbghostcells  :nlcj-1)
-               END DO
-            ENDIF
-         ENDIF
+         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV )
 #endif
-         IF( ln_wd_il )   CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt)
-
-         IF ( ln_wd_dl ) THEN 
-            !
-            ! un_e and vn_e are set to zero at faces where the direction of the flow is from dry cells 
-            !
-            DO jj = 1, jpjm1                                 
-               DO ji = 1, jpim1   
-                  IF ( zwx(ji,jj) > 0.0 ) THEN 
-                     zuwdmask(ji, jj) = ztwdmask(ji  ,jj) 
-                  ELSE 
-                     zuwdmask(ji, jj) = ztwdmask(ji+1,jj)  
-                  END IF 
-                  zwx(ji, jj) = zuwdmask(ji,jj)*zwx(ji, jj)
-                  un_e(ji,jj) = zuwdmask(ji,jj)*un_e(ji,jj)
-
-                  IF ( zwy(ji,jj) > 0.0 ) THEN
-                     zvwdmask(ji, jj) = ztwdmask(ji, jj  )
-                  ELSE 
-                     zvwdmask(ji, jj) = ztwdmask(ji, jj+1)  
-                  END IF 
-                  zwy(ji, jj) = zvwdmask(ji,jj)*zwy(ji,jj) 
-                  vn_e(ji,jj) = zvwdmask(ji,jj)*vn_e(ji,jj)
-               END DO
-            END DO
+         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rDt_e)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
+
+         IF( ln_wd_dl ) THEN           ! un_e and vn_e are set to zero at faces where 
+            !                          ! the direction of the flow is from dry cells
+            CALL wad_Umsk( ztwdmask, zhU, zhV, un_e, vn_e, zuwdmask, zvwdmask )   ! not jpi colomn for U, not jpj row for V
             !
          ENDIF    
-         
-         ! Sum over sub-time-steps to compute advective velocities
-         za2 = wgtbtp2(jn)
-         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
-         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
-         
-         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc = True) 
-         IF ( ln_wd_dl_bc ) THEN
-            zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:)
-            zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:)
-         END IF 
-
-         ! Set next sea level:
-         DO jj = 2, jpjm1                                 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   &
-                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj)
-            END DO
-         END DO
-         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:)
-         
-         CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T',  1._wp )
-
+         !
+         !
+         !     Compute Sea Level at step jit+1
+         !--           m+1        m                               m+1/2          --!
+         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --!
+         !-------------------------------------------------------------------------!
+         DO_2D( 0, 0, 0, 0 )
+            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
+            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
+         END_2D
+         !
+         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
+         !
          ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
          IF( ln_bdy )   CALL bdy_ssh( ssha_e )
@@ -884 +527 @@
          IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn )
 #endif
+         !
+         !                             ! Sum over sub-time-steps to compute advective velocities
+         za2 = wgtbtp2(jn)             ! zhU, zhV hold fluxes extrapolated at jn+0.5
+         un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:)
+         vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:)
+         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc=True) 
+         IF ( ln_wd_dl_bc ) THEN
+            zuwdav2(1:jpim1,1:jpj  ) = zuwdav2(1:jpim1,1:jpj  ) + za2 * zuwdmask(1:jpim1,1:jpj  )   ! not jpi-column
+            zvwdav2(1:jpi  ,1:jpjm1) = zvwdav2(1:jpi  ,1:jpjm1) + za2 * zvwdmask(1:jpi  ,1:jpjm1)   ! not jpj-row
+         END IF
+         !
          !  
          ! Sea Surface Height at u-,v-points (vvl case only)
          IF( .NOT.ln_linssh ) THEN                                
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )
+            DO_2D( 0, 0, 0, 0 )
+               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
+            END_2D
          ENDIF   
-         !                                 
-         ! Half-step back interpolation of SSH for surface pressure computation:
-         !----------------------------------------------------------------------
-         IF ((jn==1).AND.ll_init) THEN
-           za0=1._wp                        ! Forward-backward
-           za1=0._wp                           
-           za2=0._wp
-           za3=0._wp
-         ELSEIF ((jn==2).AND.ll_init) THEN  ! AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
-           za0= 1.0833333333333_wp          ! za0 = 1-gam-eps
-           za1=-0.1666666666666_wp          ! za1 = gam
-           za2= 0.0833333333333_wp          ! za2 = eps
-           za3= 0._wp              
-         ELSE                               ! AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880 
-            IF (rn_bt_alpha==0._wp) THEN
-               za0=0.614_wp                 ! za0 = 1/2 +   gam + 2*eps
-               za1=0.285_wp                 ! za1 = 1/2 - 2*gam - 3*eps
-               za2=0.088_wp                 ! za2 = gam
-               za3=0.013_wp                 ! za3 = eps
-            ELSE
-               zepsilon = 0.00976186_wp - 0.13451357_wp * rn_bt_alpha
-               zgamma = 0.08344500_wp - 0.51358400_wp * rn_bt_alpha
-               za0 = 0.5_wp + zgamma + 2._wp * rn_bt_alpha + 2._wp * zepsilon
-               za1 = 1._wp - za0 - zgamma - zepsilon
-               za2 = zgamma
-               za3 = zepsilon
-            ENDIF 
-         ENDIF
-         !
+         !         
+         ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2
+         !--            m+1/2           m+1              m               m-1              m-2     --!
+         !--        ssh'    =  za0 * ssh     +  za1 * ssh   +  za2 * ssh      +  za3 * ssh        --!
+         !------------------------------------------------------------------------------------------!
+         CALL ts_bck_interp( jn, ll_init, za0, za1, za2, za3 )   ! coeficients of the interpolation
          zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:)   &
             &          + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:)
-         
-         IF( ln_wd_il ) THEN                   ! Calculating and applying W/D gravity filters
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1 
-                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(    -ht_0(ji,jj)               ,    -ht_0(ji+1,jj) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_0(ji,jj) , zsshp2_e(ji+1,jj) + ht_0(ji+1,jj) ) &
-                     &                                                             > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji+1,jj))  > 1.E-12 ).AND.( &
-                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
-                     &    MAX(    -ht_0(ji,jj)               ,    -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpx(ji,jj) = 1.0_wp
-                ELSE IF(ll_tmp2) THEN
-                  ! no worries about  zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj) = 0, it won't happen ! here
-                  zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) +     ht_0(ji+1,jj) - zsshp2_e(ji,jj) - ht_0(ji,jj)) &
-                              &    / (zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj)) )
-                ELSE
-                  zcpx(ji,jj) = 0._wp
-                ENDIF
-                !
-                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(    -ht_0(ji,jj)               ,    -ht_0(ji,jj+1) ) .AND.            &
-                     &    MAX( zsshp2_e(ji,jj) + ht_0(ji,jj) , zsshp2_e(ji,jj+1) + ht_0(ji,jj+1) ) &
-                     &                                                             > rn_wdmin1 + rn_wdmin2
-                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji,jj+1))  > 1.E-12 ).AND.( &
-                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
-                     &    MAX(    -ht_0(ji,jj)               ,    -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-   
-                IF(ll_tmp1) THEN
-                  zcpy(ji,jj) = 1.0_wp
-                ELSEIF(ll_tmp2) THEN
-                  ! no worries about  zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  ) = 0, it won't happen ! here
-                  zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) +     ht_0(ji,jj+1) - zsshp2_e(ji,jj) - ht_0(ji,jj)) &
-                              &    / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  )) )
-                ELSE
-                  zcpy(ji,jj) = 0._wp
-                ENDIF
-              END DO
-           END DO
-         ENDIF
-         !
-         ! Compute associated depths at U and V points:
-         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN     !* Vector form
-            !                                        
-            DO jj = 2, jpjm1                            
-               DO ji = 2, jpim1
-                  zx1 = r1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
-                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
-                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
-                  zy1 = r1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
-                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
-                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
-                  zhust_e(ji,jj) = hu_0(ji,jj) + zx1 
-                  zhvst_e(ji,jj) = hv_0(ji,jj) + zy1
-               END DO
-            END DO
-            !
+         !
+         !                             ! Surface pressure gradient
+         zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor
+         DO_2D( 0, 0, 0, 0 )
+            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+         END_2D
+         IF( ln_wd_il ) THEN        ! W/D : gravity filters applied on pressure gradient
+            CALL wad_spg( zsshp2_e, zcpx, zcpy )   ! Calculating W/D gravity filters
+            zu_spg(2:jpim1,2:jpjm1) = zu_spg(2:jpim1,2:jpjm1) * zcpx(2:jpim1,2:jpjm1)
+            zv_spg(2:jpim1,2:jpjm1) = zv_spg(2:jpim1,2:jpjm1) * zcpy(2:jpim1,2:jpjm1)
          ENDIF
          !
@@ -994 +574 @@
          ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
          ! at each time step. We however keep them constant here for optimization.
-         ! Recall that zwx and zwy arrays hold fluxes at this stage:
-         ! zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)   ! fluxes at jn+0.5
-         ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
-         !
-         SELECT CASE( nvor_scheme )
-         CASE( np_ENT )             ! energy conserving scheme (t-point)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-
-               z1_hu = ssumask(ji,jj) / ( zhup2_e(ji,jj) + 1._wp - ssumask(ji,jj) )
-               z1_hv = ssvmask(ji,jj) / ( zhvp2_e(ji,jj) + 1._wp - ssvmask(ji,jj) )
-            
-               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                   &
-                  &               * (  e1e2t(ji+1,jj)*zhtp2_e(ji+1,jj)*ff_t(ji+1,jj) * ( va_e(ji+1,jj) + va_e(ji+1,jj-1) )   &
-                  &                  + e1e2t(ji  ,jj)*zhtp2_e(ji  ,jj)*ff_t(ji  ,jj) * ( va_e(ji  ,jj) + va_e(ji  ,jj-1) )   )
-                  !
-               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
-                  &               * (  e1e2t(ji,jj+1)*zhtp2_e(ji,jj+1)*ff_t(ji,jj+1) * ( ua_e(ji,jj+1) + ua_e(ji-1,jj+1) )   & 
-                  &                  + e1e2t(ji,jj  )*zhtp2_e(ji,jj  )*ff_t(ji,jj  ) * ( ua_e(ji,jj  ) + ua_e(ji-1,jj  ) )   ) 
-            END DO  
-         END DO  
-         !         
-         CASE( np_ENE, np_MIX )     ! energy conserving scheme (f-point)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
-                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
-                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj) = r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-                  zv_trd(ji,jj) =-r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-               END DO
-            END DO
-            !
-         CASE( np_ENS )             ! enstrophy conserving scheme (f-point)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 =   r1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
-                  zx1 = - r1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-                  zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-               END DO
-            END DO
-            !
-         CASE( np_EET , np_EEN )   ! energy & enstrophy scheme (using e3t or e3f)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  )  &
-                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  )  &
-                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1)  & 
-                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1)  )
-                  zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1)  & 
-                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1)  &
-                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  )  & 
-                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  )  )
-               END DO
-            END DO
-            ! 
-         END SELECT
+         ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated)
+         CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   )
          !
          ! Add tidal astronomical forcing if defined
          IF ( ln_tide .AND. ln_tide_pot ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF
          !
@@ -1071 +588 @@
 !jth do implicitly instead
          IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
-               END DO
-            END DO
-         ENDIF 
-         !
-         ! Surface pressure trend:
-         IF( ln_wd_il ) THEN
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1 
-                 ! Add surface pressure gradient
-                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-                 zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg * zcpx(ji,jj) 
-                 zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg * zcpy(ji,jj)
-              END DO
-           END DO
-         ELSE
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1   ! vector opt.
-                 ! Add surface pressure gradient
-                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-                 zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg
-                 zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg
-              END DO
-           END DO
-         END IF
-
+            DO_2D( 0, 0, 0, 0 )
+               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
+            END_2D
+         ENDIF
          !
          ! Set next velocities:
+         !     Compute barotropic speeds at step jit+1    (h : total height of the water colomn)
+         !--                              VECTOR FORM
+         !--   m+1                 m               /                                                       m+1/2           \    --!
+         !--  u     =             u   + delta_t' * \         (1-r)*g * grad_x( ssh') -         f * k vect u      +     frc /    --!
+         !--                                                                                                                    --!
+         !--                             FLUX FORM                                                                              --!
+         !--  m+1   __1__  /  m    m               /  m+1/2                             m+1/2              m+1/2    n      \ \  --!
+         !-- u    =   m+1 |  h  * u   + delta_t' * \ h     * (1-r)*g * grad_x( ssh') - h     * f * k vect u      + h * frc /  | --!
+         !--         h     \                                                                                                 /  --!
+         !------------------------------------------------------------------------------------------------------------------------!
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
-                            &     + rdtbt * (                      zwx(ji,jj)   &
-                            &                                 + zu_trd(ji,jj)   &
-                            &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * ssumask(ji,jj)
-
-                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
-                            &     + rdtbt * (                      zwy(ji,jj)   &
-                            &                                 + zv_trd(ji,jj)   &
-                            &                                 + zv_frc(ji,jj) ) &
-                            &   ) * ssvmask(ji,jj)
- 
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
+                         &     + rDt_e * (                   zu_spg(ji,jj)   &
+                         &                                 + zu_trd(ji,jj)   &
+                         &                                 + zu_frc(ji,jj) ) & 
+                         &   ) * ssumask(ji,jj)
+
+               va_e(ji,jj) = (                                 vn_e(ji,jj)   &
+                         &     + rDt_e * (                   zv_spg(ji,jj)   &
+                         &                                 + zv_trd(ji,jj)   &
+                         &                                 + zv_frc(ji,jj) ) &
+                         &   ) * ssvmask(ji,jj)
+            END_2D
             !
          ELSE                           !* Flux form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-
-                  zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
-                  zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
-
-                  zhura = ssumask(ji,jj)/(zhura + 1._wp - ssumask(ji,jj))
-                  zhvra = ssvmask(ji,jj)/(zhvra + 1._wp - ssvmask(ji,jj))
-
-                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   & 
-                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   & 
-                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   &
-                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) &
-                            &   ) * zhura
-
-                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   &
-                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   &
-                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   &
-                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) &
-                            &   ) * zhvra
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
+               !                    ! backward interpolated depth used in spg terms at jn+1/2
+               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
+                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
+                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+               !                    ! inverse depth at jn+1
+               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
+               z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
+               !
+               ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
+                    &            + rDt_e * (  zhu_bck        * zu_spg (ji,jj)  &   !
+                    &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
+                    &                       +  hu(ji,jj,Kmm) * zu_frc (ji,jj)  )   ) * z1_hu
+               !
+               va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
+                    &            + rDt_e * (  zhv_bck        * zv_spg (ji,jj)  &   !
+                    &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
+                    &                       +  hv(ji,jj,Kmm) * zv_frc (ji,jj)  )   ) * z1_hv
+            END_2D
          ENDIF
 !jth implicit bottom friction:
          IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj))
-                     va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj))
-               END DO
-            END DO
-         ENDIF
-
-         
-         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only)
-            hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
-            hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
-            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) )
-            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) )
-            !
-         ENDIF
-         !                                             !* domain lateral boundary
-         CALL lbc_lnk_multi( 'dynspg_ts', ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
-         !
+            DO_2D( 0, 0, 0, 0 )
+                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj))
+                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj))
+            END_2D
+         ENDIF
+       
+         IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only)
+            hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1)
+            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) )
+            hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1)
+            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) )
+         ENDIF
+         !
+         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only)
+            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  &
+                 &                         , hu_e , 'U',  1._wp, hv_e , 'V',  1._wp  &
+                 &                         , hur_e, 'U',  1._wp, hvr_e, 'V',  1._wp  )
+         ELSE
+            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  )
+         ENDIF
          !                                                 ! open boundaries
          IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
@@ -1190 +688 @@
          za1 = wgtbtp1(jn)                                    
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
+            puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) 
+            pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) 
          ELSE                                       ! Sum transports
             IF ( .NOT.ln_wd_dl ) THEN  
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:)
+               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:)
             ELSE 
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
+               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
+               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
             END IF 
          ENDIF
          !                                          ! Sum sea level
-         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
+         pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:)
 
          !                                                 ! ==================== !
@@ -1213 +711 @@
       ! Set advection velocity correction:
       IF (ln_bt_fw) THEN
-         zwx(:,:) = un_adv(:,:)
-         zwy(:,:) = vn_adv(:,:)
-         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN
-            un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) )
-            vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) )
-            !
-            ! Update corrective fluxes for next time step:
-            un_bf(:,:)  = atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:))
-            vn_bf(:,:)  = atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:))
+         IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN
+            DO_2D( 1, 1, 1, 1 )
+               zun_save = un_adv(ji,jj)
+               zvn_save = vn_adv(ji,jj)
+               !                          ! apply the previously computed correction 
+               un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - rn_atfp * un_bf(ji,jj) )
+               vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - rn_atfp * vn_bf(ji,jj) )
+               !                          ! Update corrective fluxes for next time step
+               un_bf(ji,jj)  = rn_atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) )
+               vn_bf(ji,jj)  = rn_atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) )
+               !                          ! Save integrated transport for next computation
+               ub2_b(ji,jj) = zun_save
+               vb2_b(ji,jj) = zvn_save
+            END_2D
          ELSE
-            un_bf(:,:) = 0._wp
-            vn_bf(:,:) = 0._wp 
-         END IF         
-         ! Save integrated transport for next computation
-         ub2_b(:,:) = zwx(:,:)
-         vb2_b(:,:) = zwy(:,:)
+            un_bf(:,:) = 0._wp            ! corrective fluxes for next time step set to zero
+            vn_bf(:,:) = 0._wp
+            ub2_b(:,:) = un_adv(:,:)      ! Save integrated transport for next computation
+            vb2_b(:,:) = vn_adv(:,:)
+         END IF
       ENDIF
 
@@ -1236 +738 @@
       IF( ln_dynadv_vec .OR. ln_linssh ) THEN
          DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_2dt_b
+            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt_b
+            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt_b
          END DO
       ELSE
-         ! At this stage, ssha has been corrected: compute new depths at velocity points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
-                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      &
-                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
-                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      &
-                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
-            END DO
-         END DO
+         ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points
+         DO_2D( 1, 0, 1, 0 )
+            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
+               &              * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)      &
+               &              +   e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) )
+            zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
+               &              * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)      &
+               &              +   e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) )
+         END_2D
          CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
          !
          DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_2dt_b
+            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b
+            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b
          END DO
          ! Save barotropic velocities not transport:
-         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
-         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+         puu_b(:,:,Kaa) =  puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
+         pvv_b(:,:,Kaa) =  pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
       ENDIF
 
@@ -1265 +765 @@
       ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)  
       DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
+         puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk)
+         pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk)
       END DO
 
       IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 
          DO jk = 1, jpkm1
-            un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) &
-                       & + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk) 
-            vn(:,:,jk) = ( vn_adv(:,:)*r1_hv_n(:,:) & 
-                       & + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)  
+            puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) &
+                       & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk) 
+            pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) & 
+                       & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)  
          END DO
       END IF 
 
       
-      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current
-      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current
+      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) )    ! barotropic i-current
+      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) )    ! barotropic i-current
       !
 #if defined key_agrif
@@ -1303 +803 @@
       IF( ln_wd_dl )   DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 )
       !
-      IF( ln_diatmb ) THEN
-         CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity
-         CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity
-      ENDIF
+      CALL iom_put( "baro_u" , puu_b(:,:,Kmm) )  ! Barotropic  U Velocity
+      CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) )  ! Barotropic  V Velocity
       !
    END SUBROUTINE dyn_spg_ts
@@ -1320 +818 @@
       LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
       INTEGER, INTENT(inout) :: jpit      ! cycle length    
-      REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights
+      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1, & ! Primary weights
                                                          zwgt2    ! Secondary weights
       
@@ -1332 +830 @@
       ! Set time index when averaged value is requested
       IF (ll_fw) THEN 
-         jic = nn_baro
+         jic = nn_e
       ELSE
-         jic = 2 * nn_baro
+         jic = 2 * nn_e
       ENDIF
 
@@ -1340 +838 @@
       IF (ll_av) THEN
            ! Define simple boxcar window for primary weights 
-           ! (width = nn_baro, centered around jic)     
+           ! (width = nn_e, centered around jic)     
          SELECT CASE ( nn_bt_flt )
               CASE( 0 )  ! No averaging
@@ -1346 +844 @@
                  jpit = jic
 
-              CASE( 1 )  ! Boxcar, width = nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+              CASE( 1 )  ! Boxcar, width = nn_e
+                 DO jn = 1, 3*nn_e
+                    za1 = ABS(float(jn-jic))/float(nn_e) 
                     IF (za1 < 0.5_wp) THEN
                       zwgt1(jn) = 1._wp
@@ -1355 +853 @@
                  ENDDO
 
-              CASE( 2 )  ! Boxcar, width = 2 * nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+              CASE( 2 )  ! Boxcar, width = 2 * nn_e
+                 DO jn = 1, 3*nn_e
+                    za1 = ABS(float(jn-jic))/float(nn_e) 
                     IF (za1 < 1._wp) THEN
                       zwgt1(jn) = 1._wp
@@ -1401 +899 @@
       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
          !                                   ! ---------------
-         IF( ln_rstart .AND. ln_bt_fw .AND. (neuler/=0) ) THEN    !* Read the restart file
-            IF(lrxios) CALL iom_swap( TRIM(crxios_context) )
-            CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:), ldxios = lrxios )   
-            CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:), ldxios = lrxios ) 
-            CALL iom_get( numror, jpdom_autoglo, 'un_bf'  , un_bf  (:,:), ldxios = lrxios )   
-            CALL iom_get( numror, jpdom_autoglo, 'vn_bf'  , vn_bf  (:,:), ldxios = lrxios ) 
+         IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN    !* Read the restart file
+            IF(lrxios) CALL iom_swap( TRIM(crxios_context) 
+            CALL iom_get( numror, jpdom_auto, 'ub2_b'  , ub2_b  (:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )   
+            CALL iom_get( numror, jpdom_auto, 'vb2_b'  , vb2_b  (:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
+            CALL iom_get( numror, jpdom_auto, 'un_bf'  , un_bf  (:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )   
+            CALL iom_get( numror, jpdom_auto, 'vn_bf'  , vn_bf  (:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
             IF( .NOT.ln_bt_av ) THEN
-               CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:), ldxios = lrxios )   
-               CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:), ldxios = lrxios )   
-               CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:), ldxios = lrxios )
-               CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:), ldxios = lrxios ) 
-               CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:), ldxios = lrxios )   
-               CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:), ldxios = lrxios )
+               CALL iom_get( numror, jpdom_auto, 'sshbb_e'  , sshbb_e(:,:), cd_type = 'T', psgn =  1._wp, ldxios = lrxios )   
+               CALL iom_get( numror, jpdom_auto, 'ubb_e'    ,   ubb_e(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )   
+               CALL iom_get( numror, jpdom_auto, 'vbb_e'    ,   vbb_e(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios )
+               CALL iom_get( numror, jpdom_auto, 'sshb_e'   ,  sshb_e(:,:), cd_type = 'T', psgn =  1._wp, ldxios = lrxios ) 
+               CALL iom_get( numror, jpdom_auto, 'ub_e'     ,    ub_e(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )   
+               CALL iom_get( numror, jpdom_auto, 'vb_e'     ,    vb_e(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios )
             ENDIF
 #if defined key_agrif
             ! Read time integrated fluxes
             IF ( .NOT.Agrif_Root() ) THEN
-               CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:), ldxios = lrxios )   
-               CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:), ldxios = lrxios )
+               CALL iom_get( numror, jpdom_auto, 'ub2_i_b'  , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )   
+               CALL iom_get( numror, jpdom_auto, 'vb2_i_b'  , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios )
             ENDIF
 #endif
@@ -1479 +977 @@
       ! Max courant number for ext. grav. waves
       !
-      DO jj = 1, jpj
-         DO ji =1, jpi
-            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
-            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
-            zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
-         END DO
-      END DO
-      !
-      zcmax = MAXVAL( zcu(:,:) )
+      DO_2D( 0, 0, 0, 0 )
+         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+         zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
+      END_2D
+      !
+      zcmax = MAXVAL( zcu(Nis0:Nie0,Njs0:Nje0) )
       CALL mpp_max( 'dynspg_ts', zcmax )
 
       ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
-      IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
+      IF( ln_bt_auto )   nn_e = CEILING( rn_Dt / rn_bt_cmax * zcmax)
       
-      rdtbt = rdt / REAL( nn_baro , wp )
-      zcmax = zcmax * rdtbt
+      rDt_e = rn_Dt / REAL( nn_e , wp )
+      zcmax = zcmax * rDt_e
       ! Print results
       IF(lwp) WRITE(numout,*)
@@ -1500 +996 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
       IF( ln_bt_auto ) THEN
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_baro '
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_e '
          IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax
       ELSE
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist   nn_baro = ', nn_baro
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_e in namelist   nn_e = ', nn_e
       ENDIF
 
       IF(ln_bt_av) THEN
-         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_baro time steps is on '
+         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_e time steps is on '
       ELSE
          IF(lwp) WRITE(numout,*) '     ln_bt_av =.false. => No time averaging of barotropic variables '
@@ -1527 +1023 @@
       SELECT CASE ( nn_bt_flt )
          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac'
-         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
-         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_e'
+         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_e' 
          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' )
       END SELECT
       !
       IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) '     nn_baro = ', nn_baro
-      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rdtbt
+      IF(lwp) WRITE(numout,*) '     nn_e = ', nn_e
+      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rDt_e
       IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax
       !
@@ -1546 +1042 @@
       ENDIF
       IF( zcmax>0.9_wp ) THEN
-         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )          
+         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_e !' )          
       ENDIF
       !
@@ -1581 +1077 @@
    END SUBROUTINE dyn_spg_ts_init
 
+   
+   SUBROUTINE dyn_cor_2D_init( Kmm )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_cor_2D_init  ***
+      !!
+      !! ** Purpose : Set time splitting options
+      !! Set arrays to remove/compute coriolis trend.
+      !! Do it once during initialization if volume is fixed, else at each long time step.
+      !! Note that these arrays are also used during barotropic loop. These are however frozen
+      !! although they should be updated in the variable volume case. Not a big approximation.
+      !! To remove this approximation, copy lines below inside barotropic loop
+      !! and update depths at T-F points (ht and zhf resp.) at each barotropic time step
+      !!
+      !! Compute zwz = f / ( height of the water colomn )
+      !!----------------------------------------------------------------------
+      INTEGER,  INTENT(in)         ::  Kmm  ! Time index
+      INTEGER  ::   ji ,jj, jk              ! dummy loop indices
+      REAL(wp) ::   z1_ht
+      REAL(wp), DIMENSION(jpi,jpj) :: zhf
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( nvor_scheme )
+      CASE( np_EEN )                != EEN scheme using e3f energy & enstrophy scheme
+         SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
+         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    &
+                    &           ht(ji  ,jj  ) + ht(ji+1,jj  )   ) * 0.25_wp  
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
+         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      &
+                    &                    + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   &
+                    &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
+                    &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
+         END SELECT
+         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp )
+         !
+         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
+         DO_2D( 0, 1, 0, 1 )
+            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+            ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+            ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+         END_2D
+         !
+      CASE( np_EET )                  != EEN scheme using e3t energy conserving scheme
+         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
+         DO_2D( 0, 1, 0, 1 )
+            z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) )
+            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
+            ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
+            ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
+            ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
+         END_2D
+         !
+      CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT !
+         !
+         zwz(:,:) = 0._wp
+         zhf(:,:) = 0._wp
+         
+         !!gm  assume 0 in both cases (which is almost surely WRONG ! ) as hvatf has been removed 
+!!gm    A priori a better value should be something like :
+!!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1) 
+!!gm                     divided by the sum of the corresponding mask 
+!!gm 
+!!            
+         IF( .NOT.ln_sco ) THEN
+  
+   !!gm  agree the JC comment  : this should be done in a much clear way
+  
+   ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
+   !     Set it to zero for the time being 
+   !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level
+   !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
+   !              ENDIF
+   !              zhf(:,:) = gdepw_0(:,:,jk+1)
+            !
+         ELSE
+            !
+            !zhf(:,:) = hbatf(:,:)
+            DO_2D( 1, 0, 1, 0 )
+               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
+                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
+                    &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
+                    &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
+            END_2D
+         ENDIF
+         !
+         DO jj = 1, jpjm1
+            zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
+         END DO
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
+            END DO
+         END DO
+         CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )
+         ! JC: TBC. hf should be greater than 0 
+         DO_2D( 1, 1, 1, 1 )
+            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
+         END_2D
+         zwz(:,:) = ff_f(:,:) * zwz(:,:)
+      END SELECT
+      
+   END SUBROUTINE dyn_cor_2d_init
+
+
+
+   SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_cor_2d  ***
+      !!
+      !! ** Purpose : Compute u and v coriolis trends
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji ,jj                             ! dummy loop indices
+      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      -
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pht, phu, phv, punb, pvnb, zhU, zhV
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd
+      !!----------------------------------------------------------------------
+      SELECT CASE( nvor_scheme )
+      CASE( np_ENT )                ! enstrophy conserving scheme (f-point)
+         DO_2D( 0, 0, 0, 0 )
+            z1_hu = ssumask(ji,jj) / ( phu(ji,jj) + 1._wp - ssumask(ji,jj) )
+            z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) )
+            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
+               &               * (  e1e2t(ji+1,jj)*pht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   &
+               &                  + e1e2t(ji  ,jj)*pht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   )
+               !
+            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
+               &               * (  e1e2t(ji,jj+1)*pht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   & 
+               &                  + e1e2t(ji,jj  )*pht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   ) 
+         END_2D
+         !         
+      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX
+         DO_2D( 0, 0, 0, 0 )
+            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
+            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
+            zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            ! energy conserving formulation for planetary vorticity term
+            zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+         END_2D
+         !
+      CASE( np_ENS )                ! enstrophy conserving scheme (f-point)
+         DO_2D( 0, 0, 0, 0 )
+            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
+              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
+              &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+         END_2D
+         !
+      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)         
+         DO_2D( 0, 0, 0, 0 )
+            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
+             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
+             &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
+             &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
+            zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
+             &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
+             &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
+             &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
+         END_2D
+         !
+      END SELECT
+      !
+   END SUBROUTINE dyn_cor_2D
+
+
+   SUBROUTINE wad_tmsk( pssh, ptmsk )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   set wetting & drying mask at tracer points 
+      !!              for the current barotropic sub-step 
+      !!
+      !! ** Method  :   ??? 
+      !!
+      !! ** Action  :  ptmsk : wetting & drying t-mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pssh    !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   ptmsk   !
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_wd_dl_rmp ) THEN     
+         DO_2D( 1, 1, 1, 1 )
+            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
+               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN 
+               ptmsk(ji,jj) = 1._wp
+            ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN
+               ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) )
+            ELSE 
+               ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
+      ELSE  
+         DO_2D( 1, 1, 1, 1 )
+            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp
+            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
+      ENDIF
+      !
+   END SUBROUTINE wad_tmsk
+
+
+   SUBROUTINE wad_Umsk( pTmsk, phU, phV, pu, pv, pUmsk, pVmsk )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   set wetting & drying mask at tracer points 
+      !!              for the current barotropic sub-step 
+      !!
+      !! ** Method  :   ??? 
+      !!
+      !! ** Action  :  ptmsk : wetting & drying t-mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pTmsk              ! W & D t-mask
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   phU, phV, pu, pv   ! ocean velocities and transports
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pUmsk, pVmsk       ! W & D u- and v-mask
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO_2D( 1, 1, 1, 0 )
+         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj) 
+         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)  
+         ENDIF
+         phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj)
+         pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj)
+      END_2D
+      !
+      DO_2D( 1, 0, 1, 1 )
+         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  )
+         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)  
+         ENDIF
+         phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj) 
+         pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj)
+      END_2D
+      !
+   END SUBROUTINE wad_Umsk
+
+
+   SUBROUTINE wad_spg( pshn, zcpx, zcpy )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE  wad_sp  ***
+      !!
+      !! ** Purpose : 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji ,jj               ! dummy loop indices
+      LOGICAL  ::   ll_tmp1, ll_tmp2
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pshn
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy
+      !!----------------------------------------------------------------------
+      DO_2D( 0, 0, 0, 0 )
+         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji+1,jj) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji+1,jj) + ht_0(ji+1,jj) )  &
+              &                                                         > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( pshn(ji+1,jj)            -  pshn(ji  ,jj))  > 1.E-12 ).AND.( &
+              &      MAX(   pshn(ji,jj)              ,  pshn(ji+1,jj) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+         IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+         ELSEIF(ll_tmp2) THEN
+            ! no worries about  pshn(ji+1,jj) -  pshn(ji  ,jj) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (pshn(ji+1,jj) + ht_0(ji+1,jj) - pshn(ji,jj) - ht_0(ji,jj)) &
+                 &           / (pshn(ji+1,jj) - pshn(ji  ,jj)) )
+            zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+         ELSE
+            zcpx(ji,jj) = 0._wp
+         ENDIF
+         !
+         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji,jj+1) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji,jj+1) + ht_0(ji,jj+1) )  &
+              &                                                       > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( pshn(ji,jj)              -  pshn(ji,jj+1))  > 1.E-12 ).AND.( &
+              &      MAX(   pshn(ji,jj)              ,  pshn(ji,jj+1) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+         
+         IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+         ELSE IF(ll_tmp2) THEN
+            ! no worries about  pshn(ji,jj+1) -  pshn(ji,jj  ) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (pshn(ji,jj+1) + ht_0(ji,jj+1) - pshn(ji,jj) - ht_0(ji,jj)) &
+                 &           / (pshn(ji,jj+1) - pshn(ji,jj  )) )
+            zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
+         ELSE
+            zcpy(ji,jj) = 0._wp
+         ENDIF
+      END_2D
+            
+   END SUBROUTINE wad_spg
+     
+
+
+   SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_drg_init  ***
+      !!                    
+      !! ** Purpose : - add the baroclinic top/bottom drag contribution to 
+      !!              the baroclinic part of the barotropic RHS
+      !!              - compute the barotropic drag coefficients
+      !!
+      !! ** Method  :   computation done over the INNER domain only 
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT(in   ) ::  Kbb, Kmm           ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in   ) ::  puu, pvv           ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(in   ) ::  puu_b, pvv_b       ! barotropic velocities at main time levels
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(inout) ::  pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(  out) ::  pCdU_u , pCdU_v    ! barotropic drag coefficients
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv, iktu, iktv
+      REAL(wp) ::   zztmp
+      REAL(wp), DIMENSION(jpi,jpj) ::   zu_i, zv_i
+      !!----------------------------------------------------------------------
+      !
+      !                    !==  Set the barotropic drag coef.  ==!
+      !
+      IF( ln_isfcav ) THEN          ! top+bottom friction (ocean cavities)
+         
+         DO_2D( 0, 0, 0, 0 )
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
+         END_2D
+      ELSE                          ! bottom friction only
+         DO_2D( 0, 0, 0, 0 )
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
+         END_2D
+      ENDIF
+      !
+      !                    !==  BOTTOM stress contribution from baroclinic velocities  ==!
+      !
+      IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities
+         
+         DO_2D( 0, 0, 0, 0 )
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = puu(ji,jj,ikbu,Kmm) - puu_b(ji,jj,Kmm)
+            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kmm) - pvv_b(ji,jj,Kmm)
+         END_2D
+      ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities
+         
+         DO_2D( 0, 0, 0, 0 )
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = puu(ji,jj,ikbu,Kbb) - puu_b(ji,jj,Kbb)
+            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kbb) - pvv_b(ji,jj,Kbb)
+         END_2D
+      ENDIF
+      !
+      IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please !
+         zztmp = -1._wp / rDt_e
+         DO_2D( 0, 0, 0, 0 )
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
+                 &                              r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
+                 &                              r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
+         END_2D
+      ELSE                    ! use "unclipped" drag (even if explicit friction is used in 3D calculation)
+         
+         DO_2D( 0, 0, 0, 0 )
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
+         END_2D
+      END IF
+      !
+      !                    !==  TOP stress contribution from baroclinic velocities  ==!   (no W/D case)
+      !
+      IF( ln_isfcav ) THEN
+         !
+         IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity
+            
+            DO_2D( 0, 0, 0, 0 )
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = puu(ji,jj,iktu,Kmm) - puu_b(ji,jj,Kmm)
+               zv_i(ji,jj) = pvv(ji,jj,iktv,Kmm) - pvv_b(ji,jj,Kmm)
+            END_2D
+         ELSE                                ! CENTRED integration: use BEFORE top baroclinic velocity
+            
+            DO_2D( 0, 0, 0, 0 )
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = puu(ji,jj,iktu,Kbb) - puu_b(ji,jj,Kbb)
+               zv_i(ji,jj) = pvv(ji,jj,iktv,Kbb) - pvv_b(ji,jj,Kbb)
+            END_2D
+         ENDIF
+         !
+         !                    ! use "unclipped" top drag (even if explicit friction is used in 3D calculation)
+         
+         DO_2D( 0, 0, 0, 0 )
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
+         END_2D
+         !
+      ENDIF
+      !
+   END SUBROUTINE dyn_drg_init
+
+   SUBROUTINE ts_bck_interp( jn, ll_init,       &   ! <== in
+      &                      za0, za1, za2, za3 )   ! ==> out
+      !!----------------------------------------------------------------------
+      INTEGER ,INTENT(in   ) ::   jn                   ! index of sub time step
+      LOGICAL ,INTENT(in   ) ::   ll_init              !
+      REAL(wp),INTENT(  out) ::   za0, za1, za2, za3   ! Half-step back interpolation coefficient
+      !
+      REAL(wp) ::   zepsilon, zgamma                   !   -      -
+      !!----------------------------------------------------------------------
+      !                             ! set Half-step back interpolation coefficient
+      IF    ( jn==1 .AND. ll_init ) THEN   !* Forward-backward
+         za0 = 1._wp                        
+         za1 = 0._wp                           
+         za2 = 0._wp
+         za3 = 0._wp
+      ELSEIF( jn==2 .AND. ll_init ) THEN   !* AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
+         za0 = 1.0833333333333_wp                 ! za0 = 1-gam-eps
+         za1 =-0.1666666666666_wp                 ! za1 = gam
+         za2 = 0.0833333333333_wp                 ! za2 = eps
+         za3 = 0._wp              
+      ELSE                                 !* AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880 
+         IF( rn_bt_alpha == 0._wp ) THEN      ! Time diffusion  
+            za0 = 0.614_wp                        ! za0 = 1/2 +   gam + 2*eps
+            za1 = 0.285_wp                        ! za1 = 1/2 - 2*gam - 3*eps
+            za2 = 0.088_wp                        ! za2 = gam
+            za3 = 0.013_wp                        ! za3 = eps
+         ELSE                                 ! no time diffusion
+            zepsilon = 0.00976186_wp - 0.13451357_wp * rn_bt_alpha
+            zgamma   = 0.08344500_wp - 0.51358400_wp * rn_bt_alpha
+            za0 = 0.5_wp + zgamma + 2._wp * rn_bt_alpha + 2._wp * zepsilon
+            za1 = 1._wp - za0 - zgamma - zepsilon
+            za2 = zgamma
+            za3 = zepsilon
+         ENDIF 
+      ENDIF
+   END SUBROUTINE ts_bck_interp
+
+
    !!======================================================================
 END MODULE dynspg_ts

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynvor.F90

@@ -80 +80 @@
    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation
    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       - 
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       - 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2v)/(2*e1e2f)  used in F-point metric term calculation
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       - 
    
    REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4
@@ -88 +88 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -96 +98 @@
 CONTAINS
 
-   SUBROUTINE dyn_vor( kt )
+   SUBROUTINE dyn_vor( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!
       !! ** Purpose :   compute the lateral ocean tracer physics.
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend
       !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
       !!               and planetary vorticity trends) and send them to trd_dyn 
       !!               for futher diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in  ) ::   kt          ! ocean time-step index
+      INTEGER                             , INTENT( in  ) ::   Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! ocean velocity field and RHS of momentum equation
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv
@@ -117 +121 @@
          ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) )
          !
-         ztrdu(:,:,:) = ua(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend (including Stokes-Coriolis force)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
          SELECT CASE( nvor_scheme )
-         CASE( np_ENS )           ;   CALL vor_ens( kt, ncor, un , vn , ua, va )   ! enstrophy conserving scheme
-            IF( ln_stcor )            CALL vor_ens( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ncor, un , vn , ua, va )   ! energy conserving scheme
-            IF( ln_stcor )            CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_ENT )           ;   CALL vor_enT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (T-pts)
-            IF( ln_stcor )            CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_EET )           ;   CALL vor_eeT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (een with e3t)
-            IF( ln_stcor )            CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_EEN )           ;   CALL vor_een( kt, ncor, un , vn , ua, va )   ! energy & enstrophy scheme
-            IF( ln_stcor )            CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+         CASE( np_ENS )           ;   CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! enstrophy conserving scheme
+            IF( ln_stcor )            CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme
+            IF( ln_stcor )            CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (T-pts)
+            IF( ln_stcor )            CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (een with e3t)
+            IF( ln_stcor )            CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy & enstrophy scheme
+            IF( ln_stcor )            CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          END SELECT
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt, Kmm )
          !
          IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case)
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
+            ztrdu(:,:,:) = puu(:,:,:,Krhs)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs)
             SELECT CASE( nvor_scheme )
-            CASE( np_ENT )           ;   CALL vor_enT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (T-pts)
-            CASE( np_EET )           ;   CALL vor_eeT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (een with e3t)
-            CASE( np_ENE )           ;   CALL vor_ene( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme
-            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, nrvm, un , vn , ua, va )  ! enstrophy conserving scheme
-            CASE( np_EEN )           ;   CALL vor_een( kt, nrvm, un , vn , ua, va )  ! energy & enstrophy scheme
+            CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (T-pts)
+            CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (een with e3t)
+            CASE( np_ENE )           ;   CALL vor_ene( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme
+            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! enstrophy conserving scheme
+            CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy & enstrophy scheme
             END SELECT
-            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt, Kmm )
          ENDIF
          !
@@ -156 +160 @@
          SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==!
          CASE( np_ENT )                        !* energy conserving scheme  (T-pts)
-                             CALL vor_enT( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t)
-                             CALL vor_eeT( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_ENE )                        !* energy conserving scheme
-                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_ENS )                        !* enstrophy conserving scheme
-                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend
-            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend
          CASE( np_MIX )                        !* mixed ene-ens scheme
-                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens)
-                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene)
-            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! relative vorticity or metric trend (ens)
+                             CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! planetary vorticity trend (ene)
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_EEN )                        !* energy and enstrophy conserving scheme
-                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          END SELECT
          !
@@ -179 +183 @@
       !
       !                       ! print sum trends (used for debugging)
-      IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask,               &
-         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor  - Ua: ', mask1=umask,               &
+         &                                tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_vor')
@@ -187 +191 @@
 
 
-   SUBROUTINE vor_enT( kt, kvor, pu, pv, pu_rhs, pv_rhs )
+   SUBROUTINE vor_enT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE vor_enT  ***
@@ -203 +207 @@
       !!       where rvor is the relative vorticity at f-point
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities
@@ -226 +231 @@
       CASE ( np_RVO )                           !* relative vorticity
          DO jk = 1, jpkm1                                 ! Horizontal slab
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
-                     &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D( 1, 0, 1, 0 )
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+               END_2D
             ENDIF
          END DO
 
-         CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
 
       CASE ( np_CRV )                           !* Coriolis + relative vorticity
          DO jk = 1, jpkm1                                 ! Horizontal slab
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1                          ! relative vorticity
-                  zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   &
-                     &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   &
+                  &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj)
+            END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D( 1, 0, 1, 0 )
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+               END_2D
             ENDIF
          END DO
 
-         CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
 
       END SELECT
@@ -270 +267 @@
          SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t_n(:,:,jk)
+            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm)
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   &
-                     &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 0, 1 )
+               zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   &
+                  &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) &
+                  &                  * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   &
-                     &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) * e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 0, 1 )
+               zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   &
+                  &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) &
+                  &             * e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    &
-                     &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 0, 1 )
+               zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    &
+                  &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) &
+                  &                                 * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           &
-                       &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  &
-                       &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) * e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 0, 1, 0, 1 )
+               zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           &
+                    &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  &
+                    &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) &
+                    &          * e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -305 +298 @@
          !
          !                                   !==  compute and add the vorticity term trend  =!
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)                    &
-                  &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   &
-                  &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   )
-                  !
-               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)                    &
-                  &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
-                  &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
-            END DO  
-         END DO  
+         DO_2D( 0, 0, 0, 0 )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   &
+               &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   )
+               !
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
+               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -322 +313 @@
 
 
-   SUBROUTINE vor_ene( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_ene( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE vor_ene  ***
@@ -334 +325 @@
       !!         The general trend of momentum is increased due to the vorticity 
       !!       term which is given by:
-      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ]
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u puu(:,:,:,Kmm)) ]
       !!       where rvor is the relative vorticity
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
@@ -366 +358 @@
             zwz(:,:) = ff_f(:,:) 
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      &
-                     &                        - e1u(ji,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -398 +382 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
 
          IF( ln_sco ) THEN
-            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
-            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
          ELSE
-            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+            zwx(:,:) = e2u(:,:) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pv(:,:,jk)
          ENDIF
          !                                   !==  compute and add the vorticity term trend  =!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
-               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
-               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
-               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
-               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
-            END DO  
-         END DO  
+         DO_2D( 0, 0, 0, 0 )
+            zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
+            zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
+            zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
+            zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -430 +410 @@
 
 
-   SUBROUTINE vor_ens( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_ens( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_ens  ***
@@ -441 +421 @@
       !!      potential enstrophy of a horizontally non-divergent flow. the
       !!      trend of the vorticity term is given by:
-      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
-      !!      Add this trend to the general momentum trend (ua,va):
-      !!          (ua,va) = (ua,va) + ( voru , vorv )
-      !!
-      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u puu(:,:,:,Kmm)) ]
+      !!      Add this trend to the general momentum trend:
+      !!          (u(rhs),v(Krhs)) = (u(rhs),v(Krhs)) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs)) arrays with the now vorticity term trend
       !!
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -473 +454 @@
             zwz(:,:) = ff_f(:,:) 
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  &
-                     &                        - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -505 +478 @@
          !
          IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
          !
          IF( ln_sco ) THEN                   !==  horizontal fluxes  ==!
-            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
-            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
          ELSE
-            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+            zwx(:,:) = e2u(:,:) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pv(:,:,jk)
          ENDIF
          !                                   !==  compute and add the vorticity term trend  =!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
-                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
-               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
-                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO  
-         END DO  
+         DO_2D( 0, 0, 0, 0 )
+            zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+               &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+            zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+               &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -537 +506 @@
 
 
-   SUBROUTINE vor_een( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_een( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_een  ***
@@ -548 +517 @@
       !!      both the horizontal kinetic energy and the potential enstrophy
       !!      when horizontal divergence is zero (see the NEMO documentation)
-      !!      Add this trend to the general momentum trend (ua,va).
-      !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -580 +550 @@
          SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
-                  IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
-                  ELSE                       ;   z1_e3f(ji,jj) = 0._wp
-                  ENDIF
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
-                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
-                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
-                  IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3f
-                  ELSE                       ;   z1_e3f(ji,jj) = 0._wp
-                  ENDIF
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
          END SELECT
          !
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  &
-                     &            - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (   ( pvn(ji+1,jj,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &              - ( pun(ji,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      &
-                     &                              - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  )   &
-                     &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   &
+                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                            - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -644 +604 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
       END DO                                           !   End of slab
          !
-      CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
 
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !
          !                                   !==  horizontal fluxes  ==!
-         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
 
          !                                   !==  compute and add the vorticity term trend  =!
@@ -670 +628 @@
          END DO
          DO jj = 3, jpj
-            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk)
                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk)
@@ -677 +635 @@
             END DO
          END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
-            END DO  
-         END DO  
+         DO_2D( 0, 0, 0, 0 )
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -694 +650 @@
 
 
-   SUBROUTINE vor_eeT( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_eeT  ***
@@ -705 +661 @@
       !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een).
       !!      The change consists in 
-      !!      Add this trend to the general momentum trend (ua,va).
-      !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk     ! dummy loop indices
@@ -738 +695 @@
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = ff_f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &             - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
-                     &          * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &          * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &          - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &                              - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
-                     &                         * r1_e1e2f(ji,jj)    )
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &                         * r1_e1e2f(ji,jj)    )
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                        - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -778 +725 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
       END DO
       !
-      CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
       !
       DO jk = 1, jpkm1                                 ! Horizontal slab
 
       !                                   !==  horizontal fluxes  ==!
-         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
 
          !                                   !==  compute and add the vorticity term trend  =!
@@ -798 +743 @@
          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
          DO ji = 2, jpi          ! split in 2 parts due to vector opt.
-               z1_e3t = 1._wp / e3t_n(ji,jj,jk)
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
@@ -805 +750 @@
          END DO
          DO jj = 3, jpj
-            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3
-               z1_e3t = 1._wp / e3t_n(ji,jj,jk)
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
@@ -813 +758 @@
             END DO
          END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
-            END DO  
-         END DO  
+         DO_2D( 0, 0, 0, 0 )
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -849 +792 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_vor in reference namelist : Vorticity scheme options
       READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist', lwp )
-      REWIND( numnam_cfg )              ! Namelist namdyn_vor in configuration namelist : Vorticity scheme options
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist' )
       READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist' )
       IF(lwm) WRITE ( numond, namdyn_vor )
       !
@@ -877 +818 @@
       IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat
       IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              &
-                     & + tmask(ji,jj  ,jk) + tmask(ji+1,jj+1,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp
-               END DO
-            END DO
-         END DO
+         DO_3D( 1, 0, 1, 0, 1, jpk )
+            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              &
+               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp
+         END_3D
          !
          CALL lbc_lnk( 'dynvor', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
@@ -920 +857 @@
          CASE( np_ENT )                      !* T-point metric term :   pre-compute di(e2u)/2 and dj(e1v)/2
             ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) )
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj  ) ) * 0.5_wp
-                  dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp
-               END DO
-            END DO
-            CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. )   ! Lateral boundary conditions
+            DO_2D( 0, 0, 0, 0 )
+               di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj  ) ) * 0.5_wp
+               dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp
+            END_2D
+            CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp )   ! Lateral boundary conditions
             !
          CASE DEFAULT                        !* F-point metric term :   pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f)
             ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) )
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj  ) - e2v(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
-                  dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. )   ! Lateral boundary conditions
+            DO_2D( 1, 0, 1, 0 )
+               di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj  ) - e2v(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+               dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+            END_2D
+            CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp )   ! Lateral boundary conditions
          END SELECT
          !

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynzad.F90

@@ -28 +28 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -36 +37 @@
 CONTAINS
 
-   SUBROUTINE dyn_zad ( kt )
+   SUBROUTINE dyn_zad ( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dynzad  ***
@@ -44 +45 @@
       !!
       !! ** Method  :   The now vertical advection of momentum is given by:
-      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ]
-      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ]
-      !!      Add this trend to the general trend (ua,va):
-      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!         w dz(u) = u(rhs) + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*ww) dk(u) ]
+      !!         w dz(v) = v(rhs) + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*ww) dk(v) ]
+      !!      Add this trend to the general trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)):
+      !!         (u(rhs),v(rhs)) = (u(rhs),v(rhs)) + w dz(u,v)
       !!
-      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
+      !! ** Action  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the vert. momentum adv. trends
       !!              - Send the trends to trddyn for diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step inedx
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -68 +71 @@
       ENDIF
 
-      IF( l_trddyn )   THEN         ! Save ua and va trends
+      IF( l_trddyn )   THEN         ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
       
       DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical
-         DO jj = 2, jpj                   ! vertical fluxes 
-            DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
-            DO ji = fs_2, fs_jpim1        ! vector opt.
-               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )
-               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )
-            END DO  
-         END DO   
+         DO_2D( 0, 1, 0, 1 )
+            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D( 0, 0, 0, 0 )
+            zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) )
+            zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) )
+         END_2D
       END DO
       !
       ! Surface and bottom advective fluxes set to zero
-      DO jj = 2, jpjm1        
-         DO ji = fs_2, fs_jpim1           ! vector opt.
-            zwuw(ji,jj, 1 ) = 0._wp
-            zwvw(ji,jj, 1 ) = 0._wp
-            zwuw(ji,jj,jpk) = 0._wp
-            zwvw(ji,jj,jpk) = 0._wp
-         END DO  
-      END DO
+      DO_2D( 0, 0, 0, 0 )
+         zwuw(ji,jj, 1 ) = 0._wp
+         zwvw(ji,jj, 1 ) = 0._wp
+         zwuw(ji,jj,jpk) = 0._wp
+         zwvw(ji,jj,jpk) = 0._wp
+      END_2D
       !
-      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1       ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO  
-         END DO  
-      END DO
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   &
+            &                                      / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj)   &
+            &                                      / e3v(ji,jj,jk,Kmm)
+      END_3D
 
       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt, Kmm )
          DEALLOCATE( ztrdu, ztrdv ) 
       ENDIF
       !                             ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_zad')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynzdf.F90

@@ -37 +37 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -45 +46 @@
 CONTAINS
    
-   SUBROUTINE dyn_zdf( kt )
+   SUBROUTINE dyn_zdf( kt, Kbb, Kmm, Krhs, puu, pvv, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_zdf  ***
@@ -54 +55 @@
       !!
       !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing
-      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
-      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!         u(after) =         u(before) + 2*dt *       u(rhs)                vector form or linear free surf.
+      !!         u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u_after   otherwise
       !!               - update the after velocity with the implicit vertical mixing.
       !!      This requires to solver the following system: 
-      !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ]
+      !!         u(after) = u(after) + 1/e3u_after  dk+1[ mi(avm) / e3uw_after dk[ua] ]
       !!      with the following surface/top/bottom boundary condition:
       !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2)
       !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90)
       !!
-      !! ** Action :   (ua,va)   after velocity 
+      !! ** Action :   (puu(:,:,:,Kaa),pvv(:,:,:,Kaa))   after velocity 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk         ! dummy loop indices
@@ -90 +93 @@
          ENDIF
       ENDIF
-      !                             !* set time step
-      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog)
-      ENDIF
-      !
       !                             !* explicit top/bottom drag case
-      IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, ub, vb, ua, va )  ! add top/bottom friction trend to (ua,va)
+      IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add top/bottom friction trend to (puu(Kaa),pvv(Kaa))
       !
       !
       IF( l_trddyn )   THEN         !* temporary save of ta and sa trends
          ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
-      ENDIF
-      !
-      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in ua,va)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
+      ENDIF
+      !
+      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in puu(:,:,:,Kaa),pvv(:,:,:,Kaa))
       !
       !                    ! time stepping except vertical diffusion
       IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk)
-            va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk)
-         END DO
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk)
+            pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk)
+         END_3D
       ELSE                                      ! applied on thickness weighted velocity
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
-               &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
-            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
-               &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
-         END DO
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            puu(ji,jj,jk,Kaa) = (         e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb )  &
+               &                  + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs)  ) &
+               &                        / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk)
+            pvv(ji,jj,jk,Kaa) = (         e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb )  &
+               &                  + rDt * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Krhs)  ) &
+               &                        / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk)
+         END_3D
       ENDIF
       !                    ! add top/bottom friction 
@@ -125 +125 @@
       !     J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 
       !                not lead to the effective stress seen over the whole barotropic loop. 
-      !     G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a
+      !     G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa)
       IF( ln_drgimp .AND. ln_dynspg_ts ) THEN
-         DO jk = 1, jpkm1        ! remove barotropic velocities
-            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk)
-            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
-         END DO
-         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
-               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua
-               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va
-            END DO
-         END DO
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )      ! remove barotropic velocities
+            puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk)
+            pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk)
+         END_3D
+         DO_2D( 0, 0, 0, 0 )
+            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+            ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm)    &
+               &             + r_vvl   * e3u(ji,jj,iku,Kaa)
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm)    &
+               &             + r_vvl   * e3v(ji,jj,ikv,Kaa)
+            puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+            pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+         END_2D
          IF( ln_isfcav ) THEN    ! Ocean cavities (ISF)
-            DO jj = 2, jpjm1        
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  iku = miku(ji,jj)         ! top ocean level at u- and v-points 
-                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-                  ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua
-                  va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               iku = miku(ji,jj)         ! top ocean level at u- and v-points 
+               ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm)    &
+                  &             + r_vvl   * e3u(ji,jj,iku,Kaa)
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,ikv,Kaa)
+               puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+               pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+            END_2D
          END IF
       ENDIF
@@ -158 +158 @@
       !
       !                    !* Matrix construction
-      zdt = r2dt * 0.5
+      zdt = rDt * 0.5
       IF( ln_zad_Aimp ) THEN   !!
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm)    &    ! after scale factor at U-point
+                  &             + r_vvl   * e3u(ji,jj,jk,Kaa)
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw_n(ji,jj,2) ) * wumask(ji,jj,2)
-               zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zwi(ji,jj,1) = 0._wp
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm)    &
+               &             + r_vvl   * e3u(ji,jj,1,Kaa)
+            zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) )   &
+               &         / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2)
+            zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) )    &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) )    &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -251 +241 @@
       !
       IF ( ln_drgimp ) THEN      ! implicit bottom friction
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm)    &
+               &             + r_vvl   * e3u(ji,jj,iku,Kaa)   ! after scale factor at T-point
+            zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
+         END_2D
          IF ( ln_isfcav ) THEN   ! top friction (always implicit)
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
-                  iku = miku(ji,jj)       ! ocean top level at u- and v-points 
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
+               iku = miku(ji,jj)       ! ocean top level at u- and v-points 
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm)    &
+                  &             + r_vvl   * e3u(ji,jj,iku,Kaa)   ! after scale factor at T-point
+               zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
+            END_2D
          END IF
       ENDIF
@@ -282 +270 @@
       !   m is decomposed in the product of an upper and a lower triangular matrix
       !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The solution (the after velocity) is in ua
+      !   The solution (the after velocity) is in puu(:,:,:,Kaa)
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
-            ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( 0, 0, 0, 0 )
+         ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm)    &
+            &             + r_vvl   * e3u(ji,jj,1,Kaa) 
+         puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+            &                                      / ( ze3ua * rho0 ) * umask(ji,jj,1) 
+      END_2D
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * puu(ji,jj,jk-1,Kaa)
+      END_3D
+      !
+      DO_2D( 0, 0, 0, 0 )
+         puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 )
+         puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jj,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
+      END_3D
       !
       !              !==  Vertical diffusion on v  ==!
       !
       !                       !* Matrix construction
-      zdt = r2dt * 0.5
+      zdt = rDt * 0.5
       IF( ln_zad_Aimp ) THEN   !!
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzv)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) )    &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) )    &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw_n(ji,jj,2) ) * wvmask(ji,jj,2)
-               zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zwi(ji,jj,1) = 0._wp
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm)    &
+               &             + r_vvl   * e3v(ji,jj,1,Kaa)
+            zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) )    &
+               &         / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2)
+            zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) )    &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) )    &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1        !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -416 +379 @@
       !
       IF( ln_drgimp ) THEN
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
-            END DO
-         END DO
+         DO_2D( 0, 0, 0, 0 )
+            ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm)    &
+               &             + r_vvl   * e3v(ji,jj,ikv,Kaa)   ! after scale factor at T-point
+            zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
+         END_2D
          IF ( ln_isfcav ) THEN
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va
-               END DO
-            END DO
+            DO_2D( 0, 0, 0, 0 )
+               ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm)    &
+                  &             + r_vvl   * e3v(ji,jj,ikv,Kaa)   ! after scale factor at T-point
+               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
+            END_2D
          ENDIF
       ENDIF
@@ -449 +410 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.          
-            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
-            va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
-               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( 0, 0, 0, 0 )
+         ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm)    &
+            &             + r_vvl   * e3v(ji,jj,1,Kaa) 
+         pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+            &                                      / ( ze3va * rho0 ) * vmask(ji,jj,1) 
+      END_2D
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pvv(ji,jj,jk-1,Kaa)
+      END_3D
+      !
+      DO_2D( 0, 0, 0, 0 )
+         pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 )
+         pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jj,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
+      END_3D
       !
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
-         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
+         ztrdu(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) ) / rDt - ztrdu(:,:,:)
+         ztrdv(:,:,:) = ( pvv(:,:,:,Kaa) - pvv(:,:,:,Kbb) ) / rDt - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt, Kmm )
          DEALLOCATE( ztrdu, ztrdv ) 
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' zdf  - Ua: ', mask1=umask,               &
+         &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
          !
       IF( ln_timing )   CALL timing_stop('dyn_zdf')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/sshwzv.F90

@@ -9 +9 @@
    !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
    !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work
+   !!            4.0  !  2018-12  (A. Coward) add mixed implicit/explicit advection
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering.
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   ssh_nxt       : after ssh
-   !!   ssh_swp       : filter ans swap the ssh arrays
+   !!   ssh_atf       : time filter the ssh arrays
    !!   wzv           : compute now vertical velocity
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
+   USE isf_oce        ! ice shelf
    USE dom_oce        ! ocean space and time domain variables 
    USE sbc_oce        ! surface boundary condition: ocean
@@ -25 +28 @@
    USE bdydyn2d       ! bdy_ssh routine
 #if defined key_agrif
+   USE agrif_oce
    USE agrif_oce_interp
 #endif
@@ -43 +47 @@
    PUBLIC   wzv        ! called by step.F90
    PUBLIC   wAimp      ! called by step.F90
-   PUBLIC   ssh_swp    ! called by step.F90
+   PUBLIC   ssh_atf    ! called by step.F90
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -54 +60 @@
 CONTAINS
 
-   SUBROUTINE ssh_nxt( kt )
+   SUBROUTINE ssh_nxt( kt, Kbb, Kmm, pssh, Kaa )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE ssh_nxt  ***
       !!                   
-      !! ** Purpose :   compute the after ssh (ssha)
+      !! ** Purpose :   compute the after ssh (ssh(Kaa))
       !!
       !! ** Method  : - Using the incompressibility hypothesis, the ssh increment
@@ -64 +70 @@
       !!      by the time step.
       !!
-      !! ** action  :   ssha, after sea surface height
+      !! ** action  :   ssh(:,:,Kaa), after sea surface height
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER                         , INTENT(in   ) ::   kt             ! time step
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height
       ! 
-      INTEGER  ::   jk            ! dummy loop indice
-      REAL(wp) ::   z2dt, zcoef   ! local scalars
+      INTEGER  ::   jk      ! dummy loop index
+      REAL(wp) ::   zcoef   ! local scalar
       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace
       !!----------------------------------------------------------------------
@@ -83 +91 @@
       ENDIF
       !
-      z2dt = 2._wp * rdt                          ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
-      zcoef = 0.5_wp * r1_rau0
+      zcoef = 0.5_wp * r1_rho0
 
       !                                           !------------------------------!
@@ -91 +97 @@
       !                                           !------------------------------!
       IF(ln_wd_il) THEN
-         CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt)
-      ENDIF
-
-      CALL div_hor( kt )                               ! Horizontal divergence
+         CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), rDt, Kmm, uu, vv )
+      ENDIF
+
+      CALL div_hor( kt, Kbb, Kmm )                     ! Horizontal divergence
       !
       zhdiv(:,:) = 0._wp
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
-        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+        zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk)
       END DO
       !                                                ! Sea surface elevation time stepping
@@ -104 +110 @@
       ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
       ! 
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+      pssh(:,:,Kaa) = (  pssh(:,:,Kbb) - rDt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
       !
 #if defined key_agrif
+      Kbb_a = Kbb   ;   Kmm_a = Kmm   ;   Krhs_a = Kaa
       CALL agrif_ssh( kt )
 #endif
@@ -112 +119 @@
       IF ( .NOT.ln_dynspg_ts ) THEN
          IF( ln_bdy ) THEN
-            CALL lbc_lnk( 'sshwzv', ssha, 'T', 1. )    ! Not sure that's necessary
-            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+            CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary
+            CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries
          ENDIF
       ENDIF
@@ -120 +127 @@
       !                                           !------------------------------!
       !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kaa), clinfo1=' pssh(:,:,Kaa)  - : ', mask1=tmask )
       !
       IF( ln_timing )   CALL timing_stop('ssh_nxt')
@@ -127 +134 @@
 
    
-   SUBROUTINE wzv( kt )
+   SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE wzv  ***
@@ -138 +145 @@
       !!        The boundary conditions are w=0 at the bottom (no flux) and.
       !!
-      !! ** action  :   wn      : now vertical velocity
+      !! ** action  :   pww      : now vertical velocity
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER                         , INTENT(in)    ::   kt             ! time step
+      INTEGER                         , INTENT(in)    ::   Kbb, Kmm, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pww            ! vertical velocity at Kmm
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   z1_2dt       ! local scalars
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdiv
       !!----------------------------------------------------------------------
@@ -156 +164 @@
          IF(lwp) WRITE(numout,*) '~~~~~ '
          !
-         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
+         pww(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
       ENDIF
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
       !                                           !------------------------------!
-      z1_2dt = 1. / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1. / rdt
-      !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases
+      !
+      !                                               !===============================!
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      !==  z_tilde and layer cases  ==!
+         !                                            !===============================!
          ALLOCATE( zhdiv(jpi,jpj,jpk) ) 
          !
@@ -170 +178 @@
             ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t)
             ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
+            DO_2D( 0, 0, 0, 0 )
+               zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+            END_2D
+         END DO
+         CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
          !                             ! Is it problematic to have a wrong vertical velocity in boundary cells?
-         !                             ! Same question holds for hdivn. Perhaps just for security
+         !                             ! Same question holds for hdiv. Perhaps just for security
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
             ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    &
-               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk)
-         END DO
-         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0
+            pww(:,:,jk) = pww(:,:,jk+1) - (   e3t(:,:,jk,Kmm) * hdiv(:,:,jk)   &
+               &                            +                  zhdiv(:,:,jk)   &
+               &                            + r1_Dt * (  e3t(:,:,jk,Kaa)       &
+               &                                       - e3t(:,:,jk,Kbb) )   ) * tmask(:,:,jk)
+         END DO
+         !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0
          DEALLOCATE( zhdiv ) 
-      ELSE   ! z_star and linear free surface cases
+         !                                            !=================================!
+      ELSEIF( ln_linssh )   THEN                      !==  linear free surface cases  ==!
+         !                                            !=================================!
+         DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence
+            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)  ) * tmask(:,:,jk)
+         END DO
+         !                                            !==========================================!
+      ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco')
+         !                                            !==========================================!
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
-            ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 &
-               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk)
+            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 &
+               &                            + r1_Dt * (  e3t(:,:,jk,Kaa)        &
+               &                                       - e3t(:,:,jk,Kbb)  )   ) * tmask(:,:,jk)
          END DO
       ENDIF
@@ -196 +212 @@
       IF( ln_bdy ) THEN
          DO jk = 1, jpkm1
-            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
-         END DO
-      ENDIF
-      !
-#if defined key_agrif 
-      IF( .NOT. AGRIF_Root() ) THEN 
-         IF ((nbondi ==  1).OR.(nbondi == 2)) wn(nlci-1 , :     ,:) = 0.e0      ! east 
-         IF ((nbondi == -1).OR.(nbondi == 2)) wn(2      , :     ,:) = 0.e0      ! west 
-         IF ((nbondj ==  1).OR.(nbondj == 2)) wn(:      ,nlcj-1 ,:) = 0.e0      ! north 
-         IF ((nbondj == -1).OR.(nbondj == 2)) wn(:      ,2      ,:) = 0.e0      ! south 
+            pww(:,:,jk) = pww(:,:,jk) * bdytmask(:,:)
+         END DO
+      ENDIF
+      !
+#if defined key_agrif
+      IF( .NOT. AGRIF_Root() ) THEN
+         !
+         ! Mask vertical velocity at first/last columns/row 
+         ! inside computational domain (cosmetic) 
+         DO jk = 1, jpkm1
+            IF( lk_west ) THEN                             ! --- West --- !
+               DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+                  DO jj = 1, jpj
+                     pww(ji,jj,jk) = 0._wp 
+                  END DO
+               END DO
+            ENDIF
+            IF( lk_east ) THEN                             ! --- East --- !
+               DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+                  DO jj = 1, jpj
+                     pww(ji,jj,jk) = 0._wp
+                  END DO
+               END DO
+            ENDIF
+            IF( lk_south ) THEN                            ! --- South --- !
+               DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+                  DO ji = 1, jpi
+                     pww(ji,jj,jk) = 0._wp
+                  END DO
+               END DO
+            ENDIF
+            IF( lk_north ) THEN                            ! --- North --- !
+               DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+                  DO ji = 1, jpi
+                     pww(ji,jj,jk) = 0._wp
+                  END DO
+               END DO
+            ENDIF
+            !
+         END DO
+         !
       ENDIF 
-#endif 
+#endif
       !
       IF( ln_timing )   CALL timing_stop('wzv')
@@ -214 +261 @@
 
 
-   SUBROUTINE ssh_swp( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ssh_nxt  ***
-      !!
-      !! ** Purpose :   achieve the sea surface  height time stepping by 
-      !!              applying Asselin time filter and swapping the arrays
-      !!              ssha  already computed in ssh_nxt  
+   SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh, pssh_f )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_atf  ***
+      !!
+      !! ** Purpose :   Apply Asselin time filter to now SSH.
       !!
       !! ** Method  : - apply Asselin time fiter to now ssh (excluding the forcing
       !!              from the filter, see Leclair and Madec 2010) and swap :
-      !!                sshn = ssha + atfp * ( sshb -2 sshn + ssha )
-      !!                            - atfp * rdt * ( emp_b - emp ) / rau0
-      !!                sshn = ssha
-      !!
-      !! ** action  : - sshb, sshn   : before & now sea surface height
-      !!                               ready for the next time step
+      !!                pssh(:,:,Kmm) = pssh(:,:,Kaa) + rn_atfp * ( pssh(:,:,Kbb) -2 pssh(:,:,Kmm) + pssh(:,:,Kaa) )
+      !!                            - rn_atfp * rn_Dt * ( emp_b - emp ) / rho0
+      !!
+      !! ** action  : - pssh(:,:,Kmm) time filtered
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpt)          , TARGET, INTENT(inout) ::   pssh           ! SSH field
+      REAL(wp), DIMENSION(jpi,jpj    ), OPTIONAL, TARGET, INTENT(  out) ::   pssh_f         ! filtered SSH field
       !
       REAL(wp) ::   zcoef   ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('ssh_swp')
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zssh   ! pointer for filtered SSH 
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('ssh_atf')
       !
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'
+         IF(lwp) WRITE(numout,*) 'ssh_atf : Asselin time filter of sea surface height'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
       !              !==  Euler time-stepping: no filter, just swap  ==!
-      IF ( neuler == 0 .AND. kt == nit000 ) THEN
-         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now)
-         !
-      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==!
-         !                                                  ! before <-- now filtered
-         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )
-         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed
-            zcoef = atfp * rdt * r1_rau0
-            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
-               &                             -    rnf_b(:,:) + rnf   (:,:)   &
-               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:)
+      IF ( .NOT.( l_1st_euler ) ) THEN   ! Only do time filtering for leapfrog timesteps
+         IF( PRESENT( pssh_f ) ) THEN   ;   zssh => pssh_f
+         ELSE                           ;   zssh => pssh(:,:,Kmm)
          ENDIF
-         sshn(:,:) = ssha(:,:)                              ! now <-- after
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask )
-      !
-      IF( ln_timing )   CALL timing_stop('ssh_swp')
-      !
-   END SUBROUTINE ssh_swp
-
-   SUBROUTINE wAimp( kt )
+         !                                                  ! filtered "now" field
+         pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) )
+         IF( .NOT.ln_linssh ) THEN                          ! "now" <-- with forcing removed
+            zcoef = rn_atfp * rn_Dt * r1_rho0
+            pssh(:,:,Kmm) = pssh(:,:,Kmm) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
+               &                             - rnf_b(:,:)        + rnf   (:,:)       &
+               &                             + fwfisf_cav_b(:,:) - fwfisf_cav(:,:)   &
+               &                             + fwfisf_par_b(:,:) - fwfisf_par(:,:)   ) * ssmask(:,:)
+
+            ! ice sheet coupling
+            IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:)
+
+         ENDIF
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' pssh(:,:,Kmm)  - : ', mask1=tmask )
+      !
+      IF( ln_timing )   CALL timing_stop('ssh_atf')
+      !
+   END SUBROUTINE ssh_atf
+
+   
+   SUBROUTINE wAimp( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE wAimp  ***
@@ -276 +328 @@
       !! ** Method  : - 
       !!
-      !! ** action  :   wn      : now vertical velocity (to be handled explicitly)
+      !! ** action  :   ww      : now vertical velocity (to be handled explicitly)
       !!            :   wi      : now vertical velocity (for implicit treatment)
       !!
-      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !! Reference  : Shchepetkin, A. F. (2015): An adaptive, Courant-number-dependent
+      !!              implicit scheme for vertical advection in oceanic modeling. 
+      !!              Ocean Modelling, 91, 38-69.
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER, INTENT(in) ::   Kmm  ! time level index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp)             ::   zCu, zcff, z1_e3t                     ! local scalars
+      REAL(wp)             ::   zCu, zcff, z1_e3t, zdt                ! local scalars
       REAL(wp) , PARAMETER ::   Cu_min = 0.15_wp                      ! local parameters
-      REAL(wp) , PARAMETER ::   Cu_max = 0.27                         ! local parameters
+      REAL(wp) , PARAMETER ::   Cu_max = 0.30_wp                      ! local parameters
       REAL(wp) , PARAMETER ::   Cu_cut = 2._wp*Cu_max - Cu_min        ! local parameters
       REAL(wp) , PARAMETER ::   Fcu    = 4._wp*Cu_max*(Cu_max-Cu_min) ! local parameters
@@ -300 +355 @@
       ENDIF
       !
-      !
-      DO jk = 1, jpkm1            ! calculate Courant numbers
-         DO jj = 2, jpjm1
-            DO ji = 2, fs_jpim1   ! vector opt.
-               z1_e3t = 1._wp / e3t_n(ji,jj,jk)
-               Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )   &  ! 2*rdt and not r2dt (for restartability)
-                  &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk), 0._wp ) -   &
-                  &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) )   &
-                  &                               * r1_e1e2t(ji,jj)                                                 &
-                  &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk), 0._wp ) -   &
-                  &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) )   &
-                  &                               * r1_e1e2t(ji,jj)                                                 &
-                  &                             ) * z1_e3t
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. )
+      ! Calculate Courant numbers
+      zdt = 2._wp * rn_Dt                            ! 2*rn_Dt and not rDt (for restartability)
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+            Cu_adv(ji,jj,jk) =   zdt *                                                         &
+               &  ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) )            &
+               &  + ( MAX( e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)                                  &
+               &                        * uu (ji  ,jj,jk,Kmm) + un_td(ji  ,jj,jk), 0._wp ) -   &
+               &      MIN( e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)                                  &
+               &                        * uu (ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                                     &
+               &  + ( MAX( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)                                  &
+               &                        * vv (ji,jj  ,jk,Kmm) + vn_td(ji,jj  ,jk), 0._wp ) -   &
+               &      MIN( e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)                                  &
+               &                        * vv (ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                                     &
+               &                             ) * z1_e3t
+         END_3D
+      ELSE
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+            Cu_adv(ji,jj,jk) =   zdt *                                                      &
+               &  ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) )         &
+               &                             + ( MAX( e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kmm)*uu(ji  ,jj,jk,Kmm), 0._wp ) -   &
+               &                                 MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                 &
+               &                             + ( MAX( e1v(ji,jj  )*e3v(ji,jj  ,jk,Kmm)*vv(ji,jj  ,jk,Kmm), 0._wp ) -   &
+               &                                 MIN( e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kmm)*vv(ji,jj-1,jk,Kmm), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                 &
+               &                             ) * z1_e3t
+         END_3D
+      ENDIF
+      CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp )
       !
       CALL iom_put("Courant",Cu_adv)
       !
       IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere
-         DO jk = jpkm1, 2, -1                           ! or scan Courant criterion and partition
-            DO jj = 1, jpj                              ! w where necessary
-               DO ji = 1, jpi
-                  !
-                  zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
+         DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )
+            !
+            zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
 ! alt:
-!                  IF ( wn(ji,jj,jk) > 0._wp ) THEN 
+!                  IF ( ww(ji,jj,jk) > 0._wp ) THEN 
 !                     zCu =  Cu_adv(ji,jj,jk) 
 !                  ELSE
 !                     zCu =  Cu_adv(ji,jj,jk-1)
 !                  ENDIF 
-                  !
-                  IF( zCu <= Cu_min ) THEN              !<-- Fully explicit
-                     zcff = 0._wp
-                  ELSEIF( zCu < Cu_cut ) THEN           !<-- Mixed explicit
-                     zcff = ( zCu - Cu_min )**2
-                     zcff = zcff / ( Fcu + zcff )
-                  ELSE                                  !<-- Mostly implicit
-                     zcff = ( zCu - Cu_max )/ zCu
-                  ENDIF
-                  zcff = MIN(1._wp, zcff)
-                  !
-                  wi(ji,jj,jk) =           zcff   * wn(ji,jj,jk)
-                  wn(ji,jj,jk) = ( 1._wp - zcff ) * wn(ji,jj,jk)
-                  !
-                  Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient
-               END DO
-            END DO
-         END DO
+            !
+            IF( zCu <= Cu_min ) THEN              !<-- Fully explicit
+               zcff = 0._wp
+            ELSEIF( zCu < Cu_cut ) THEN           !<-- Mixed explicit
+               zcff = ( zCu - Cu_min )**2
+               zcff = zcff / ( Fcu + zcff )
+            ELSE                                  !<-- Mostly implicit
+               zcff = ( zCu - Cu_max )/ zCu
+            ENDIF
+            zcff = MIN(1._wp, zcff)
+            !
+            wi(ji,jj,jk) =           zcff   * ww(ji,jj,jk)
+            ww(ji,jj,jk) = ( 1._wp - zcff ) * ww(ji,jj,jk)
+            !
+            Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient below and in stp_ctl
+         END_3D
          Cu_adv(:,:,1) = 0._wp 
       ELSE
          ! Fully explicit everywhere
-         Cu_adv(:,:,:) = 0._wp                          ! Reuse array to output coefficient
+         Cu_adv(:,:,:) = 0._wp                          ! Reuse array to output coefficient below and in stp_ctl
          wi    (:,:,:) = 0._wp
       ENDIF
       CALL iom_put("wimp",wi) 
       CALL iom_put("wi_cff",Cu_adv)
-      CALL iom_put("wexp",wn)
+      CALL iom_put("wexp",ww)
       !
       IF( ln_timing )   CALL timing_stop('wAimp')

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/wet_dry.F90

@@ -31 +31 @@
    PRIVATE
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! critical depths,filters, limiters,and masks for  Wetting and Drying
@@ -61 +64 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
 CONTAINS
@@ -79 +81 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying
       READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.) 
-      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying
+905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist' ) 
       READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
-906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. )
+906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist' )
       IF(lwm) WRITE ( numond, namwad )
       !
@@ -122 +122 @@
 
 
-   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )
+   SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE wad_lmt  ***
@@ -132 +132 @@
       !! ** Action  : - calculate flux limiter and W/D flag
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p !
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp
-      REAL(wp)                , INTENT(in   ) ::   z2dt
+      REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1
+      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp
+      REAL(wp)                            , INTENT(in   ) ::   z2dt
+      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays
       !
       INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
@@ -150 +152 @@
       !
       DO jk = 1, jpkm1
-         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:) 
-         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:) 
+         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
+         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
       END DO
       jflag  = 0
@@ -165 +167 @@
       !
       DO jk = 1, jpkm1     ! Horizontal Flux in u and v direction
-         zflxu(:,:) = zflxu(:,:) + e3u_n(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
-         zflxv(:,:) = zflxv(:,:) + e3v_n(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
+         zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)
+         zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)
       END DO
       zflxu(:,:) = zflxu(:,:) * e2u(:,:)
@@ -172 +174 @@
       !
       wdmask(:,:) = 1._wp
-      DO jj = 2, jpj
-         DO ji = 2, jpi 
-            !
-            IF( tmask(ji,jj,1)        < 0.5_wp )   CYCLE    ! we don't care about land cells
-            IF( ht_0(ji,jj) - ssh_ref > zdepwd )   CYCLE    ! and cells which are unlikely to dry
-            !
-            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
-            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
-            !
-            zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1
-            IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary
-               sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
-               IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
-               IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
-               IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
-               IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
-               wdmask(ji,jj) = 0._wp
-            END IF
-         END DO
-      END DO
+      DO_2D( 0, 1, 0, 1 )
+         !
+         IF( tmask(ji,jj,1)        < 0.5_wp )   CYCLE    ! we don't care about land cells
+         IF( ht_0(ji,jj) - ssh_ref > zdepwd )   CYCLE    ! and cells which are unlikely to dry
+         !
+         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
+         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
+         !
+         zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1
+         IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary
+            psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
+            IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
+            IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
+            IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
+            IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
+            wdmask(ji,jj) = 0._wp
+         END IF
+      END_2D
       !
       !           ! HPG limiter from jholt
-      wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
+      wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
       !jth assume don't need a lbc_lnk here
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) )
-            wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) )
-         END DO
-      END DO
+      DO_2D( 1, 0, 1, 0 )
+         wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) )
+         wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) )
+      END_2D
       !           ! end HPG limiter
       !
@@ -213 +211 @@
          jflag = 0     ! flag indicating if any further iterations are needed
          !
-         DO jj = 2, jpj
-            DO ji = 2, jpi 
-               IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE 
-               IF( ht_0(ji,jj)      > zdepwd )   CYCLE
-               !
-               ztmp = e1e2t(ji,jj)
-               !
-               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj  ) , 0._wp)   &
-                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,  jj-1) , 0._wp) 
-               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj  ) , 0._wp)   &
-                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp) 
-               !
-               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-               zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
-               !
-               IF( zdep1 > zdep2 ) THEN
-                  wdmask(ji, jj) = 0._wp
-                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                  ! flag if the limiter has been used but stop flagging if the only
-                  ! changes have zeroed the coefficient since further iterations will
-                  ! not change anything
-                  IF( zcoef > 0._wp ) THEN   ;   jflag = 1 
-                  ELSE                       ;   zcoef = 0._wp
-                  ENDIF
-                  IF( jk1 > nn_wdit )   zcoef = 0._wp
-                  IF( zflxu1(ji  ,jj  ) > 0._wp )   zwdlmtu(ji  ,jj  ) = zcoef
-                  IF( zflxu1(ji-1,jj  ) < 0._wp )   zwdlmtu(ji-1,jj  ) = zcoef
-                  IF( zflxv1(ji  ,jj  ) > 0._wp )   zwdlmtv(ji  ,jj  ) = zcoef
-                  IF( zflxv1(ji  ,jj-1) < 0._wp )   zwdlmtv(ji  ,jj-1) = zcoef
+         DO_2D( 0, 1, 0, 1 )
+            IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE 
+            IF( ht_0(ji,jj)      > zdepwd )   CYCLE
+            !
+            ztmp = e1e2t(ji,jj)
+            !
+            zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj  ) , 0._wp)   &
+               &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,  jj-1) , 0._wp) 
+            zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj  ) , 0._wp)   &
+               &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp) 
+            !
+            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+            zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj)
+            !
+            IF( zdep1 > zdep2 ) THEN
+               wdmask(ji, jj) = 0._wp
+               zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+               !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+               ! flag if the limiter has been used but stop flagging if the only
+               ! changes have zeroed the coefficient since further iterations will
+               ! not change anything
+               IF( zcoef > 0._wp ) THEN   ;   jflag = 1 
+               ELSE                       ;   zcoef = 0._wp
                ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
+               IF( jk1 > nn_wdit )   zcoef = 0._wp
+               IF( zflxu1(ji  ,jj  ) > 0._wp )   zwdlmtu(ji  ,jj  ) = zcoef
+               IF( zflxu1(ji-1,jj  ) < 0._wp )   zwdlmtu(ji-1,jj  ) = zcoef
+               IF( zflxv1(ji  ,jj  ) > 0._wp )   zwdlmtv(ji  ,jj  ) = zcoef
+               IF( zflxv1(ji  ,jj-1) < 0._wp )   zwdlmtv(ji  ,jj-1) = zcoef
+            ENDIF
+         END_2D
+         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp )
          !
          CALL mpp_max('wet_dry', jflag)   !max over the global domain
@@ -255 +251 @@
       !
       DO jk = 1, jpkm1
-         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:) 
-         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:) 
+         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
+         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
       END DO
-      un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
-      vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
+      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :)
+      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :)
       !
 !!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere !
-      CALL lbc_lnk_multi( 'wet_dry', un  , 'U', -1., vn  , 'V', -1. )
-      CALL lbc_lnk_multi( 'wet_dry', un_b, 'U', -1., vn_b, 'V', -1. )
+      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1.0_wp, pvv(:,:,:,Kmm)  , 'V', -1.0_wp )
+      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp )
 !!gm
       !
       IF(jflag == 1 .AND. lwp)   WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
       !
-      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
       !
       IF( ln_timing )   CALL timing_stop('wad_lmt')      !
@@ -275 +271 @@
 
 
-   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
+   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rDt_e )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE wad_lmt  ***
@@ -285 +281 @@
       !! ** Action  : - calculate flux limiter and W/D flag
       !!----------------------------------------------------------------------
-      REAL(wp)                , INTENT(in   ) ::   rdtbt    ! ocean time-step index
+      REAL(wp)                , INTENT(in   ) ::   rDt_e    ! ocean time-step index
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc  
       !
@@ -304 +300 @@
       zdepwd = 50._wp   ! maximum depth that ocean cells can have W/D processes
       !
-      z2dt = rdtbt   
+      z2dt = rDt_e   
       !
       zflxp(:,:)   = 0._wp
@@ -311 +307 @@
       zwdlmtv(:,:) = 1._wp
       !
-      DO jj = 2, jpj      ! Horizontal Flux in u and v direction
-         DO ji = 2, jpi 
-            !
-            IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
-            IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
-            !
-            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
-            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
-            !
-            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
-            IF( zdep2 <= 0._wp ) THEN  !add more safety, but not necessary
-              sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
-              IF( zflxu(ji  ,jj  ) > 0._wp)   zwdlmtu(ji  ,jj  ) = 0._wp
-              IF( zflxu(ji-1,jj  ) < 0._wp)   zwdlmtu(ji-1,jj  ) = 0._wp
-              IF( zflxv(ji  ,jj  ) > 0._wp)   zwdlmtv(ji  ,jj  ) = 0._wp
-              IF( zflxv(ji  ,jj-1) < 0._wp)   zwdlmtv(ji  ,jj-1) = 0._wp 
-            ENDIF
-         END DO
-      END DO
+      DO_2D( 0, 1, 0, 1 )
+         !
+         IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
+         IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+         !
+         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
+         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
+         !
+         zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
+         IF( zdep2 <= 0._wp ) THEN  !add more safety, but not necessary
+           sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
+           IF( zflxu(ji  ,jj  ) > 0._wp)   zwdlmtu(ji  ,jj  ) = 0._wp
+           IF( zflxu(ji-1,jj  ) < 0._wp)   zwdlmtu(ji-1,jj  ) = 0._wp
+           IF( zflxv(ji  ,jj  ) > 0._wp)   zwdlmtv(ji  ,jj  ) = 0._wp
+           IF( zflxv(ji  ,jj-1) < 0._wp)   zwdlmtv(ji  ,jj-1) = 0._wp 
+         ENDIF
+      END_2D
       !
       DO jk1 = 1, nn_wdit + 1      !! start limiter iterations 
@@ -339 +333 @@
          jflag = 0     ! flag indicating if any further iterations are needed
          !
-         DO jj = 2, jpj
-            DO ji = 2, jpi 
-               !
-               IF( tmask(ji, jj, 1 ) < 0.5_wp )   CYCLE 
-               IF( ht_0(ji,jj)       > zdepwd )   CYCLE
-               !
-               ztmp = e1e2t(ji,jj)
-               !
-               zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp)   &
-                  &   + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
-               zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp)   &
-                  &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
-          
-               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-               zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
-          
-               IF(zdep1 > zdep2) THEN
-                 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                 ! flag if the limiter has been used but stop flagging if the only
-                 ! changes have zeroed the coefficient since further iterations will
-                 ! not change anything
-                 IF( zcoef > 0._wp ) THEN
-                    jflag = 1 
-                 ELSE
-                    zcoef = 0._wp
-                 ENDIF
-                 IF(jk1 > nn_wdit) zcoef = 0._wp
-                 IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
-                 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
-                 IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
-                 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
-               END IF
-            END DO ! ji loop
-         END DO  ! jj loop
-         !
-         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
+         DO_2D( 0, 1, 0, 1 )
+            !
+            IF( tmask(ji, jj, 1 ) < 0.5_wp )   CYCLE 
+            IF( ht_0(ji,jj)       > zdepwd )   CYCLE
+            !
+            ztmp = e1e2t(ji,jj)
+            !
+            zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp)   &
+               &   + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+            zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp)   &
+               &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+       
+            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
+       
+            IF(zdep1 > zdep2) THEN
+              zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+              !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+              ! flag if the limiter has been used but stop flagging if the only
+              ! changes have zeroed the coefficient since further iterations will
+              ! not change anything
+              IF( zcoef > 0._wp ) THEN
+                 jflag = 1 
+              ELSE
+                 zcoef = 0._wp
+              ENDIF
+              IF(jk1 > nn_wdit) zcoef = 0._wp
+              IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+              IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+              IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+              IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
+            END IF
+         END_2D
+         !
+         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp )
          !
          CALL mpp_max('wet_dry', jflag)   !max over the global domain
@@ -387 +379 @@
       !
 !!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop
-      CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1., zflxv, 'V', -1. )
+      CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp )
 !!gm end
       !
       IF( jflag == 1 .AND. lwp )   WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
       !
-      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
       !
       IF( ln_timing )   CALL timing_stop('wad_lmt_bt')      !

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette