Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -24,4 +24,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0, NEMO Consortium (2016)
@@ -72,23 +74,21 @@
       !                          
       ! Position coordinates (in grid points)
-      !                          ==========         
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            
-            zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp )
-            zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp
+      !                          ==========
+      DO_2D_11_11
+         
+         zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp )
+         zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp
+         
+         plamt(ji,jj) = zti
+         plamu(ji,jj) = zui
+         plamv(ji,jj) = zti
+         plamf(ji,jj) = zui
+         
+         pphit(ji,jj) = ztj
+         pphiv(ji,jj) = zvj
+         pphiu(ji,jj) = ztj
+         pphif(ji,jj) = zvj
 
-            plamt(ji,jj) = zti
-            plamu(ji,jj) = zui
-            plamv(ji,jj) = zti
-            plamf(ji,jj) = zui
-   
-            pphit(ji,jj) = ztj
-            pphiv(ji,jj) = zvj
-            pphiu(ji,jj) = ztj
-            pphif(ji,jj) = zvj
-            
-         END DO
-      END DO
+      END_2D
       !     
       ! Horizontal scale factors (in meters)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_istate.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_istate.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_istate.F90	(revision 13197)
@@ -28,4 +28,6 @@
    PUBLIC   usr_def_istate   ! called by istate.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2016)
@@ -62,9 +64,7 @@
       !
       ! define unique value on each point. z2d ranging from 0.05 to -0.05
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + mjg(jj) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) )
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + (mjg(jj)-1) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) )
+      END_2D
       !
       ! sea level:
@@ -78,6 +78,6 @@
          pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:)           ! 30 to 31 +/- 0.05 psu
          ! velocities:
-         pu(:,:,jk) = z2d(:,:) * 0.1_wp                                   ! +/- 0.005  m/s
-         pv(:,:,jk) = z2d(:,:) * 0.01_wp                                  ! +/- 0.0005 m/s
+         pu(:,:,jk) = z2d(:,:) *  0.1_wp * umask(:,:,jk)                  ! +/- 0.005  m/s
+         pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk)                  ! +/- 0.0005 m/s
       ENDDO
       !
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_sbc.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_sbc.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/BENCH/MY_SRC/usrdef_sbc.F90	(revision 13197)
@@ -34,4 +34,6 @@
    PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2016)
@@ -102,9 +104,7 @@
       !
       ! define unique value on each point. z2d ranging from 0.05 to -0.05
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) )
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) )
+      END_2D
       utau_ice(:,:) = 0.1_wp +  z2d(:,:)
       vtau_ice(:,:) = 0.1_wp +  z2d(:,:)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/diawri.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/diawri.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/diawri.F90	(revision 13197)
@@ -26,4 +26,7 @@
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers 
+   USE isf_oce
+   USE isfcpl
+   USE abl            ! abl variables in case ln_abl = .true.
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
@@ -65,5 +68,7 @@
    PUBLIC   dia_wri_state
    PUBLIC   dia_wri_alloc           ! Called by nemogcm module
-
+#if ! defined key_iomput   
+   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
+#endif
    INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
    INTEGER ::          nb_T              , ndim_bT   ! grid_T file
@@ -71,9 +76,13 @@
    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
    INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
+   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file   
    INTEGER ::   ndex(1)                              ! ???
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -147,10 +156,8 @@
       CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature
       IF ( iom_use("sbt") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
+         END_2D
          CALL iom_put( "sbt", z2d )                ! bottom temperature
       ENDIF
@@ -159,10 +166,8 @@
       CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity
       IF ( iom_use("sbs") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
+         END_2D
          CALL iom_put( "sbs", z2d )                ! bottom salinity
       ENDIF
@@ -171,14 +176,12 @@
          zztmp = rho0 * 0.25
          z2d(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
-                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
-               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
-               !
-            END DO
-         END DO
+         DO_2D_00_00
+            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
+            z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
+            !
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "taubot", z2d )           
@@ -188,10 +191,8 @@
       CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current
       IF ( iom_use("sbu") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbku(ji,jj)
-               z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbku(ji,jj)
+            z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
+         END_2D
          CALL iom_put( "sbu", z2d )                ! bottom i-current
       ENDIF
@@ -200,13 +201,13 @@
       CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current
       IF ( iom_use("sbv") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkv(ji,jj)
-               z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkv(ji,jj)
+            z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
+         END_2D
          CALL iom_put( "sbv", z2d )                ! bottom j-current
       ENDIF
 
+      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
+      !
       CALL iom_put( "woce", ww )                   ! vertical velocity
       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
@@ -219,4 +220,6 @@
          IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
       ENDIF
+      !
+      IF( ln_zad_Aimp ) ww = ww - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output
 
       CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef.
@@ -227,33 +230,12 @@
       IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
 
-      IF ( iom_use("salgrad") .OR. iom_use("salgrad2") ) THEN
-         z3d(:,:,jpk) = 0.
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1                                    ! sal gradient
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp  = ts(ji,jj,jk,jp_sal,Kmm)
-                  zztmpx = ( ts(ji+1,jj,jk,jp_sal,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,jk,jp_sal,Kmm) ) * r1_e1u(ji-1,jj)
-                  zztmpy = ( ts(ji,jj+1,jk,jp_sal,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,jk,jp_sal,Kmm) ) * r1_e2v(ji,jj-1)
-                  z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
-                     &                 * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
-         CALL iom_put( "salgrad2",  z3d )          ! square of module of sal gradient
-         z3d(:,:,:) = SQRT( z3d(:,:,:) )
-         CALL iom_put( "salgrad" ,  z3d )          ! module of sal gradient
-      ENDIF
-         
       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
-         DO jj = 2, jpjm1                                    ! sst gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp  = ts(ji,jj,1,jp_tem,Kmm)
-               zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
-               zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
-               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
-                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zztmp  = ts(ji,jj,1,jp_tem,Kmm)
+            zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
+            zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
+            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
+               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
@@ -265,11 +247,7 @@
       IF( iom_use("heatc") ) THEN
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "heatc", rho0_rcp * z2d )   ! vertically integrated heat content (J/m2)
       ENDIF
@@ -277,11 +255,7 @@
       IF( iom_use("saltc") ) THEN
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "saltc", rho0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
@@ -289,11 +263,7 @@
       IF( iom_use("salt2c") ) THEN
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "salt2c", rho0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
@@ -301,15 +271,11 @@
       IF ( iom_use("eken") ) THEN
          z3d(:,:,jpk) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
-                  z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
-                     &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
-                     &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
-                     &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
+               &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
+               &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
+               &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
          CALL iom_put( "eken", z3d )                 ! kinetic energy
@@ -321,27 +287,18 @@
          z3d(1,:, : ) = 0._wp
          z3d(:,1, : ) = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  z3d(ji,jj,jk) = 0.25_wp * ( uu(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)  &
-                     &                      + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)  &
-                     &                      + vv(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm) * e1e2v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)  &
-                     &                      + vv(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)  )  &
-                     &                    * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         
+         DO_3D_00_00( 1, jpkm1 )
+            z3d(ji,jj,jk) = 0.25_wp * ( uu(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)  &
+               &                      + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)  &
+               &                      + vv(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm) * e1e2v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)  &
+               &                      + vv(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)  )  &
+               &                    * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
          CALL iom_put( "ke", z3d ) ! kinetic energy
 
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "ke_zint", z2d )   ! vertically integrated kinetic energy
 
@@ -353,41 +310,28 @@
          
          z3d(:,:,jpk) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  z3d(ji,jj,jk) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm)    &
-                     &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z3d(ji,jj,jk) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm)    &
+               &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm)  ) * r1_e1e2f(ji,jj)
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'F', 1. )
          CALL iom_put( "relvor", z3d )                  ! relative vorticity
 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 
+         END_3D
          CALL iom_put( "absvor", z3d )                  ! absolute vorticity
 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ze3  = (  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( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3
-                  ELSE                      ;   ze3 = 0._wp
-                  ENDIF
-                  z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            ze3  = (  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( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3
+            ELSE                      ;   ze3 = 0._wp
+            ENDIF
+            z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'F', 1. )
          CALL iom_put( "potvor", z3d )                  ! potential vorticity
 
       ENDIF
-   
       !
       IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
@@ -404,11 +348,7 @@
       IF( iom_use("u_heattr") ) THEN
          z2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
@@ -417,11 +357,7 @@
       IF( iom_use("u_salttr") ) THEN
          z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
@@ -439,11 +375,7 @@
       IF( iom_use("v_heattr") ) THEN
          z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
@@ -452,11 +384,7 @@
       IF( iom_use("v_salttr") ) THEN
          z2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
@@ -465,11 +393,7 @@
       IF( iom_use("tosmint") ) THEN
          z2d(:,:) = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
          CALL iom_put( "tosmint", rho0 * z2d )        ! Vertical integral of temperature
@@ -477,11 +401,7 @@
       IF( iom_use("somint") ) THEN
          z2d(:,:)=0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
          CALL iom_put( "somint", rho0 * z2d )         ! Vertical integral of salinity
@@ -490,5 +410,5 @@
       CALL iom_put( "bn2", rn2 )                      ! Brunt-Vaisala buoyancy frequency (N^2)
       !
-          
+      
       IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging
 
@@ -506,13 +426,25 @@
       INTEGER, DIMENSION(2) :: ierr
       !!----------------------------------------------------------------------
-      ierr = 0
-      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
-         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
-         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
+      IF( nn_write == -1 ) THEN
+         dia_wri_alloc = 0
+      ELSE    
+         ierr = 0
+         ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
+            &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
+            &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
          !
-      dia_wri_alloc = MAXVAL(ierr)
-      CALL mpp_sum( 'diawri', dia_wri_alloc )
+         dia_wri_alloc = MAXVAL(ierr)
+         CALL mpp_sum( 'diawri', dia_wri_alloc )
+         !
+      ENDIF
       !
    END FUNCTION dia_wri_alloc
+ 
+   INTEGER FUNCTION dia_wri_alloc_abl()
+      !!----------------------------------------------------------------------
+	  ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
+      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
+      !
+   END FUNCTION dia_wri_alloc_abl
 
    
@@ -538,4 +470,5 @@
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   ipka                                     ! ABL
       INTEGER  ::   jn, ierror                               ! local integers
       REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
@@ -543,4 +476,5 @@
       REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
       !!----------------------------------------------------------------------
       !
@@ -576,4 +510,5 @@
       ijmi = 1      ;      ijma = jpj
       ipk = jpk
+      IF(ln_abl) ipka = jpkam1
 
       ! define time axis
@@ -678,4 +613,20 @@
             &          "m", ipk, gdepw_1d, nz_W, "down" )
 
+         IF( ln_abl ) THEN 
+         ! Define the ABL grid FILE ( nid_A )
+            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
+            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+               &          nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
+            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
+               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
+            !                                                            ! Index of ocean points
+			ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
+			zw3d_abl(:,:,:) = 1._wp 
+			CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
+            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
+			DEALLOCATE(zw3d_abl)
+         ENDIF
 
          ! Declare all the output fields as NETCDF variables
@@ -727,5 +678,29 @@
          CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-!
+         !
+         IF( ln_abl ) THEN
+            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )		 			   
+#if defined key_si3
+            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#endif
+            CALL histend( nid_A, snc4chunks=snc4set )
+         ENDIF
+         !
          IF( ln_icebergs ) THEN
             CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
@@ -885,5 +860,28 @@
       CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
-!
+      !
+      IF( ln_abl ) THEN 
+         ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
+         IF( ln_mskland )   THEN 
+            DO jk=1,jpka
+               zw3d_abl(:,:,jk) = tmask(:,:,1)
+            END DO       
+         ELSE
+            zw3d_abl(:,:,:) = 1._wp		 
+         ENDIF			
+         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh 
+         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
+         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
+         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
+         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl		 
+         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
+         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
+         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl	
+#if defined key_si3
+         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
+#endif
+         DEALLOCATE(zw3d_abl)
+      ENDIF
+      !
       IF( ln_icebergs ) THEN
          !
@@ -931,5 +929,9 @@
       CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
 
-      CALL histwrite( nid_W, "vovecrtz", it, ww             , ndim_T, ndex_T )    ! vert. current
+      IF( ln_zad_Aimp ) THEN
+         CALL histwrite( nid_W, "vovecrtz", it, ww + wi     , ndim_T, ndex_T )    ! vert. current
+      ELSE
+         CALL histwrite( nid_W, "vovecrtz", it, ww          , ndim_T, ndex_T )    ! vert. current
+      ENDIF
       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
       CALL histwrite( nid_W, "votkeavm", it, avm            , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
@@ -951,4 +953,5 @@
          CALL histclo( nid_V )
          CALL histclo( nid_W )
+         IF(ln_abl) CALL histclo( nid_A )
       ENDIF
       !
@@ -974,5 +977,5 @@
       CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
       !!
-      INTEGER :: inum
+      INTEGER :: inum, jk
       !!----------------------------------------------------------------------
       ! 
@@ -981,11 +984,7 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
       IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
-
-#if defined key_si3
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
-#else
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
-#endif
-
+      !
+      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
+      !
       CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature
       CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity
@@ -993,5 +992,32 @@
       CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
       CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
-      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                )    ! now k-velocity
+      IF( ln_zad_Aimp ) THEN
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity
+      ELSE
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
+      ENDIF
+      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity
+      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height
+      !
+      IF ( ln_isf ) THEN
+         IF (ln_isfcav_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 )
+         END IF
+         IF (ln_isfpar_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 )
+         END IF
+      END IF
+      !
       IF( ALLOCATED(ahtu) ) THEN
          CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point
@@ -1017,13 +1043,21 @@
          CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity
       ENDIF
- 
+      IF ( ln_abl ) THEN
+         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind
+         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind
+         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature
+         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity
+      ENDIF
+      !
+      CALL iom_close( inum )
+      ! 
 #if defined key_si3
       IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
+         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
          CALL ice_wri_state( inum )
+         CALL iom_close( inum )
       ENDIF
 #endif
-      !
-      CALL iom_close( inum )
-      ! 
+
    END SUBROUTINE dia_wri_state
 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/domvvl.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/domvvl.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/domvvl.F90	(revision 13197)
@@ -37,4 +37,5 @@
 
    PUBLIC  dom_vvl_init       ! called by domain.F90
+   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90
    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
    PUBLIC  dom_vvl_sf_update  ! called by step.F90
@@ -62,4 +63,6 @@
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -116,21 +119,48 @@
       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
       !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
+      !
+      !                    ! Allocate module arrays
+      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+      !
+      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+      CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
+      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
+      !
+      CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column
+      !
+   END SUBROUTINE dom_vvl_init
+   !
+   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa)
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_init  ***
+      !!                   
+      !! ** Purpose :  Interpolation of all scale factors, 
+      !!               depths and water column heights
+      !!
+      !! ** Method  :  - interpolate scale factors
+      !!
+      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
+      !!              - Regrid: e3(u/v)_n
+      !!                        e3(u/v)_b       
+      !!                        e3w_n           
+      !!                        e3(u/v)w_b      
+      !!                        e3(u/v)w_n      
+      !!                        gdept_n, gdepw_n and gde3w_n
+      !!              - h(t/u/v)_0
+      !!              - frq_rst_e3t and frq_rst_hdv
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+      !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk
       INTEGER ::   ii0, ii1, ij0, ij1
       REAL(wp)::   zcoef
       !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      !
-      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
-      !
-      !                    ! Allocate module arrays
-      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
-      !
-      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
-      CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
-      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
       !
       !                    !== Set of all other vertical scale factors  ==!  (now and before)
@@ -160,22 +190,18 @@
       gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb)
       gdepw(:,:,1,Kbb) = 0.0_wp
-      DO jk = 2, jpk                               ! vertical sum
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-               !                             ! 0.5 where jk = mikt     
+      DO_3D_11_11( 2, jpk )
+         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+         !                             ! 0.5 where jk = mikt     
 !!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ??
-               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
-               gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
-               gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
-                  &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
-               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
-               gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb)
-               gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  &
-                  &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
-            END DO
-         END DO
-      END DO
+         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb)
+         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
+      END_3D
       !
       !                    !==  thickness of the water column  !!   (ocean portion only)
@@ -212,27 +238,25 @@
          ENDIF
          IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO_2D_11_11
 !!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
-                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
-                     ! values outside the equatorial band and transition zone (ztilde)
-                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
-                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
-                     ! values inside the equatorial band (ztilde as zstar)
-                     frq_rst_e3t(ji,jj) =  0.0_wp
-                     frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt
-                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
-                     !                                      ! (linearly transition from z-tilde to z-star)
-                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
-                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                     frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                &
-                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   &
-                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                  ENDIF
-               END DO
-            END DO
+               IF( ABS(gphit(ji,jj)) >= 6.) THEN
+                  ! values outside the equatorial band and transition zone (ztilde)
+                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
+                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
+               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
+                  ! values inside the equatorial band (ztilde as zstar)
+                  frq_rst_e3t(ji,jj) =  0.0_wp
+                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt
+               ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                  !                                      ! (linearly transition from z-tilde to z-star)
+                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
+                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                &
+                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   &
+                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+               ENDIF
+            END_2D
             IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
                IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
@@ -264,5 +288,5 @@
       ENDIF
       !
-   END SUBROUTINE dom_vvl_init
+   END SUBROUTINE dom_vvl_zgr
 
 
@@ -329,6 +353,6 @@
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
-         !                                                            ! ------baroclinic part------ !
+      IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
+         !                                                               ! ------baroclinic part------ !
          ! I - initialization
          ! ==================
@@ -383,31 +407,21 @@
          zwu(:,:) = 0._wp
          zwv(:,:) = 0._wp
-         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
-                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
-                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
-            DO ji = 1, jpi
-               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
-               vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
-            END DO
-         END DO
-         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
-                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
+            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
+         END_3D
+         DO_2D_11_11
+            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
+            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
+         END_2D
+         DO_3D_00_00( 1, jpkm1 )
+            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
+               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
+               &                                            ) * r1_e1e2t(ji,jj)
+         END_3D
          !                       ! d - thickness diffusion transport: boundary conditions
          !                             (stored for tracer advction and continuity equation)
@@ -416,6 +430,4 @@
          ! 4 - Time stepping of baroclinic scale factors
          ! ---------------------------------------------
-         ! Leapfrog time stepping
-         ! ~~~~~~~~~~~~~~~~~~~~~~
          CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp )
          tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
@@ -613,10 +625,4 @@
          tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)
       ENDIF
-      gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm)
-      gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm)
-
-      e3t(:,:,:,Kmm) = e3t(:,:,:,Kaa)
-      e3u(:,:,:,Kmm) = e3u(:,:,:,Kaa)
-      e3v(:,:,:,Kmm) = e3v(:,:,:,Kaa)
 
       ! Compute all missing vertical scale factor and depths
@@ -641,17 +647,13 @@
       gdepw(:,:,1,Kmm) = 0.0_wp
       gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
-      DO jk = 2, jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-                                                                 ! 1 for jk = mikt
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
-               gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  &
-                   &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
-               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 2, jpk )
+        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                           ! 1 for jk = mikt
+         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  &
+             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+      END_3D
 
       ! Local depth and Inverse of the local depth of the water
@@ -700,40 +702,28 @@
          !
       CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
-                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
          !
       CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
-                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
          !
       CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
-                     &                       *    r1_e1e2f(ji,jj)                                                  &
-                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+               &                       *    r1_e1e2f(ji,jj)                                                  &
+               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
@@ -810,7 +800,9 @@
             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
+            !
             !                             ! --------- !
             !                             ! all cases !
             !                             ! --------- !
+            !
             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
@@ -828,5 +820,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)
@@ -835,5 +827,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )
                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
@@ -842,5 +834,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'
                IF(lwp) write(numout,*) 'Compute scale factor from sshn'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                DO jk = 1, jpk
                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
@@ -895,12 +887,10 @@
                   ssh(:,:,Kbb) = -ssh_ref
 
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
-                           ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )
-                           ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )
-                        ENDIF
-                     ENDDO
-                  ENDDO
+                  DO_2D_11_11
+                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
+                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )
+                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )
+                     ENDIF
+                  END_2D
                ENDIF !If test case else
 
@@ -913,25 +903,25 @@
                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
 
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
-                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
-                     ENDIF
-                  END DO 
-               END DO 
+               DO_2D_11_11
+                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
+                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
+                  ENDIF
+               END_2D
                !
             ELSE
                !
-               ! usr_def_istate called here only to get sshb, that is needed to initialize e3t(Kbb) and e3t(Kmm)
-               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )
-               ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn)
+               ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm)
+               !
+               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )  
+               !
+               ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v
                !
                DO jk=1,jpk
-                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &
-                    &                              / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-                    &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )   ! make sure e3t_b != 0 on land points
+                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &
+                    &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+                    &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )   ! make sure e3t(:,:,:,Kbb) != 0 on land points
                END DO
                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)
-               ssh(:,:  ,Kmm) = ssh(:,:  ,Kbb)   ! needed later for gde3w
+               ssh(:,:,Kmm) = ssh(:,:,Kbb)                                     ! needed later for gde3w
                !
             END IF           ! end of ll_wd edits
@@ -1025,5 +1015,4 @@
       !
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
-      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
       !
       IF(lwp) THEN                   ! Print the choice
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/sbcmod.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/sbcmod.F90	(revision 13159)
+++ 	(revision )
@@ -1,590 +1,0 @@
-MODULE sbcmod
-   !!======================================================================
-   !!                       ***  MODULE  sbcmod  ***
-   !! Surface module :  provide to the ocean its surface boundary condition
-   !!======================================================================
-   !! History :  3.0  ! 2006-07  (G. Madec)  Original code
-   !!            3.1  ! 2008-08  (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface
-   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
-   !!            3.3  ! 2010-10  (S. Masson)  add diurnal cycle
-   !!            3.3  ! 2010-09  (D. Storkey) add ice boundary conditions (BDY)
-   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
-   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing
-   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
-   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
-   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting
-   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   sbc_init      : read namsbc namelist
-   !!   sbc           : surface ocean momentum, heat and freshwater boundary conditions
-   !!   sbc_final     : Finalize CICE ice model (if used)
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE trc_oce        ! shared ocean-passive tracers variables
-   USE sbc_ice        ! Surface boundary condition: ice fields
-   USE sbcdcy         ! surface boundary condition: diurnal cycle
-   USE sbcssm         ! surface boundary condition: sea-surface mean variables
-   USE sbcflx         ! surface boundary condition: flux formulation
-   USE sbcblk         ! surface boundary condition: bulk formulation
-   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
-#if defined key_si3
-   USE icestp         ! surface boundary condition: SI3 sea-ice model
-#endif
-   USE sbcice_cice    ! surface boundary condition: CICE sea-ice model
-   USE sbcisf         ! surface boundary condition: ice-shelf
-   USE sbccpl         ! surface boundary condition: coupled formulation
-   USE cpl_oasis3     ! OASIS routines for coupling
-   USE sbcssr         ! surface boundary condition: sea surface restoring
-   USE sbcrnf         ! surface boundary condition: runoffs
-   USE sbcapr         ! surface boundary condition: atmo pressure 
-   USE sbcisf         ! surface boundary condition: ice shelf
-   USE sbcfwb         ! surface boundary condition: freshwater budget
-   USE icbstp         ! Icebergs
-   USE icb_oce  , ONLY : ln_passive_mode      ! iceberg interaction mode
-   USE traqsr         ! active tracers: light penetration
-   USE sbcwave        ! Wave module
-   USE bdy_oce   , ONLY: ln_bdy
-   USE usrdef_sbc     ! user defined: surface boundary condition
-   USE closea         ! closed sea
-   !
-   USE prtctl         ! Print control                    (prt_ctl routine)
-   USE iom            ! IOM library
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE timing         ! Timing
-   USE wet_dry
-   USE diu_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   sbc        ! routine called by step.F90
-   PUBLIC   sbc_init   ! routine called by opa.F90
-
-   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: sbcmod.F90 11480 2019-08-29 09:23:25Z davestorkey $
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE sbc_init( Kbb, Kmm, Kaa )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE sbc_init ***
-      !!
-      !! ** Purpose :   Initialisation of the ocean surface boundary computation
-      !!
-      !! ** Method  :   Read the namsbc namelist and set derived parameters
-      !!                Call init routines for all other SBC modules that have one
-      !!
-      !! ** Action  : - read namsbc parameters
-      !!              - nsbc: type of sbc
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa         ! ocean time level indices
-      INTEGER ::   ios, icpt                         ! local integer
-      LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
-      !!
-      NAMELIST/namsbc/ nn_fsbc  ,                                                    &
-         &             ln_usr   , ln_flx   , ln_blk       ,                          &
-         &             ln_cpl   , ln_mixcpl, nn_components,                          &
-         &             nn_ice   , ln_ice_embd,                                       &
-         &             ln_traqsr, ln_dm2dc ,                                         &
-         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     &
-         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor   ,     &
-         &             ln_tauw  , nn_lsm, nn_sdrift
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'sbc_init : surface boundary condition setting'
-         WRITE(numout,*) '~~~~~~~~ '
-      ENDIF
-      !
-      !                       !**  read Surface Module namelist
-      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary
-      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
-      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namsbc )
-      !
-#if defined key_mpp_mpi
-      ncom_fsbc = nn_fsbc    ! make nn_fsbc available for lib_mpp
-#endif
-      !                             !* overwrite namelist parameter using CPP key information
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)
-         IF( lk_si3  )   nn_ice      = 2
-         IF( lk_cice )   nn_ice      = 3
-      ENDIF
-#else
-      IF( lk_si3  )   nn_ice      = 2
-      IF( lk_cice )   nn_ice      = 3
-#endif
-      !
-      IF(lwp) THEN                  !* Control print
-         WRITE(numout,*) '   Namelist namsbc (partly overwritten with CPP key setting)'
-         WRITE(numout,*) '      frequency update of sbc (and ice)             nn_fsbc       = ', nn_fsbc
-         WRITE(numout,*) '      Type of air-sea fluxes : '
-         WRITE(numout,*) '         user defined formulation                   ln_usr        = ', ln_usr
-         WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx
-         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk
-         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : '
-         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
-         WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl
-!!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist 
-         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis
-         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components
-         WRITE(numout,*) '      Sea-ice : '
-         WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice
-         WRITE(numout,*) '         ice embedded into ocean                    ln_ice_embd   = ', ln_ice_embd
-         WRITE(numout,*) '      Misc. options of sbc : '
-         WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr
-         WRITE(numout,*) '            daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc
-         WRITE(numout,*) '         Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr
-         WRITE(numout,*) '         FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb
-         WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn
-         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf
-         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf
-         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm
-         WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave
-         WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw
-         WRITE(numout,*) '                  vertical parametrization          nn_sdrift     = ', nn_sdrift
-         WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc     = ', ln_tauwoc
-         WRITE(numout,*) '               wave modified ocean stress component ln_tauw       = ', ln_tauw
-         WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor
-         WRITE(numout,*) '               neutral drag coefficient (CORE,NCAR) ln_cdgw       = ', ln_cdgw
-      ENDIF
-      !
-      IF( .NOT.ln_wave ) THEN
-         ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false.
-      ENDIF 
-      IF( ln_sdw ) THEN
-         IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) &
-            CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' )
-      ENDIF
-      ll_st_bv2014  = ( nn_sdrift==jp_breivik_2014 )
-      ll_st_li2017  = ( nn_sdrift==jp_li_2017 )
-      ll_st_bv_li   = ( ll_st_bv2014 .OR. ll_st_li2017 )
-      ll_st_peakfr  = ( nn_sdrift==jp_peakfr )
-      IF( ln_tauwoc .AND. ln_tauw ) &
-         CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', &
-                                  '(ln_tauwoc=.true. and ln_tauw=.true.)' )
-      IF( ln_tauwoc ) &
-         CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' )
-      IF( ln_tauw ) &
-         CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', &
-                              'This will override any other specification of the ocean stress' )
-      !
-      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case)
-         IF( MOD( rday , rn_Dt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
-         IF( MOD( rday , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
-         IF( MOD( rn_Dt, 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
-      ENDIF
-      !                       !**  check option consistency
-      !
-      IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS) 
-      SELECT CASE( nn_components )
-      CASE( jp_iam_nemo )
-         IF(lwp) WRITE(numout,*) '   ==>>>   NEMO configured as a single executable (i.e. including both OPA and Surface module)'
-      CASE( jp_iam_opa  )
-         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, OPA component'
-         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
-         IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA'   )
-         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
-      CASE( jp_iam_sas  )
-         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, SAS component'
-         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
-         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
-      CASE DEFAULT
-         CALL ctl_stop( 'sbc_init : unsupported value for nn_components' )
-      END SELECT
-      !                             !* coupled options
-      IF( ln_cpl ) THEN
-         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : coupled mode with an atmosphere model (ln_cpl=T)',   &
-            &                                  '           required to defined key_oasis3' )
-      ENDIF
-      IF( ln_mixcpl ) THEN
-         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) ',   &
-            &                                  '           required to defined key_oasis3' )
-         IF( .NOT.ln_cpl    )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) requires ln_cpl = T' )
-         IF( nn_components /= jp_iam_nemo )    &
-            &                   CALL ctl_stop( 'sbc_init : the mixed forced-coupled mode (ln_mixcpl=T) ',   &
-            &                                   '          not yet working with sas-opa coupling via oasis' )
-      ENDIF
-      !                             !* sea-ice
-      SELECT CASE( nn_ice )
-      CASE( 0 )                        !- no ice in the domain
-      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
-      CASE( 2 )                        !- SI3  ice model
-      CASE( 3 )                        !- CICE ice model
-         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
-         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
-      CASE DEFAULT                     !- not supported
-      END SELECT
-      IF( ln_diurnal .AND. .NOT. ln_blk  )   CALL ctl_stop( "sbc_init: diurnal flux processing only implemented for bulk forcing" )
-      !
-      !                       !**  allocate and set required variables
-      !
-      !                             !* allocate sbc arrays
-      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
-#if ! defined key_si3 && ! defined key_cice
-      IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_ice arrays' )
-#endif
-      !
-      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
-         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp
-         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp
-      END IF
-      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero
-         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case
-      ENDIF
-      !
-      sfx   (:,:) = 0._wp           !* salt flux due to freezing/melting
-      fmmflx(:,:) = 0._wp           !* freezing minus melting flux
-
-      taum(:,:) = 0._wp             !* wind stress module (needed in GLS in case of reduced restart)
-
-      !                          ! Choice of the Surface Boudary Condition (set nsbc)
-      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle
-         nday_qsr = -1   ! allow initialization at the 1st call
-         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   &
-            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
-      ENDIF
-      !                             !* Choice of the Surface Boudary Condition
-      !                             (set nsbc)
-      !
-      ll_purecpl  = ln_cpl .AND. .NOT.ln_mixcpl
-      ll_opa      = nn_components == jp_iam_opa
-      ll_not_nemo = nn_components /= jp_iam_nemo
-      icpt = 0
-      !
-      IF( ln_usr          ) THEN   ;   nsbc = jp_usr     ; icpt = icpt + 1   ;   ENDIF       ! user defined         formulation
-      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
-      IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation
-      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
-      IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
-      !
-      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init : choose ONE and only ONE sbc option' )
-      !
-      IF(lwp) THEN                     !- print the choice of surface flux formulation
-         WRITE(numout,*)
-         SELECT CASE( nsbc )
-         CASE( jp_usr     )   ;   WRITE(numout,*) '   ==>>>   user defined forcing formulation'
-         CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation'
-         CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation'
-         CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation'
-!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter
-         CASE( jp_none    )   ;   WRITE(numout,*) '   ==>>>   OPA coupled to SAS via oasis'
-            IF( ln_mixcpl )       WRITE(numout,*) '               + forced-coupled mixed formulation'
-         END SELECT
-         IF( ll_not_nemo  )       WRITE(numout,*) '               + OASIS coupled SAS'
-      ENDIF
-      !
-      !                             !* OASIS initialization
-      !
-      IF( lk_oasis )   CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step
-      !                                              !                      (2) the use of nn_fsbc
-      !     nn_fsbc initialization if OPA-SAS coupling via OASIS
-      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
-      IF( nn_components /= jp_iam_nemo ) THEN
-         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt)
-         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt)
-         !
-         IF(lwp)THEN
-            WRITE(numout,*)
-            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-      !
-      !                             !* check consistency between model timeline and nn_fsbc
-      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
-          MOD( nstock             , nn_fsbc) /= 0 ) THEN
-         WRITE(ctmp1,*) 'sbc_init : experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
-            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
-         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
-      ENDIF
-      !
-      IF( MOD( rday, REAL(nn_fsbc, wp) * rn_Dt ) /= 0 )   &
-         &  CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' )
-      !
-      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rn_Dt) ) < 8  )   &
-         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
-      !
-   
-      !                       !**  associated modules : initialization
-      !
-                          CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization
-      !
-      IF( ln_blk      )   CALL sbc_blk_init              ! bulk formulae initialization
-
-      IF( ln_ssr      )   CALL sbc_ssr_init              ! Sea-Surface Restoring initialization
-      !
-      IF( ln_isf      )   CALL sbc_isf_init( Kmm )       ! Compute iceshelves
-      !
-                          CALL sbc_rnf_init( Kmm )       ! Runof initialization
-      !
-      IF( ln_apr_dyn )    CALL sbc_apr_init              ! Atmo Pressure Forcing initialization
-      !
-#if defined key_si3
-      IF( lk_agrif .AND. nn_ice == 0 ) THEN            ! allocate ice arrays in case agrif + ice-model + no-ice in child grid
-                          IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )
-      ELSEIF( nn_ice == 2 ) THEN
-                          CALL ice_init( Kbb, Kmm, Kaa )         ! ICE initialization
-      ENDIF
-#endif
-      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization
-      !
-      IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation
-      !
-      IF( lwxios ) THEN
-         CALL iom_set_rstw_var_active('utau_b')
-         CALL iom_set_rstw_var_active('vtau_b')
-         CALL iom_set_rstw_var_active('qns_b')
-         ! The 3D heat content due to qsr forcing is treated in traqsr
-         ! CALL iom_set_rstw_var_active('qsr_b')
-         CALL iom_set_rstw_var_active('emp_b')
-         CALL iom_set_rstw_var_active('sfx_b')
-      ENDIF
-
-   END SUBROUTINE sbc_init
-
-
-   SUBROUTINE sbc( kt, Kbb, Kmm )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE sbc  ***
-      !!
-      !! ** Purpose :   provide at each time-step the ocean surface boundary
-      !!                condition (momentum, heat and freshwater fluxes)
-      !!
-      !! ** Method  :   blah blah  to be written ?????????
-      !!                CAUTION : never mask the surface stress field (tke sbc)
-      !!
-      !! ** Action  : - set the ocean surface boundary condition at before and now
-      !!                time step, i.e.
-      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
-      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp
-      !!              - updte the ice fraction : fr_i
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
-      !
-      LOGICAL ::   ll_sas, ll_opa   ! local logical
-      !
-      REAL(wp) ::     zthscl        ! wd  tanh scale
-      REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt  
-
-      !!---------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('sbc')
-      !
-      !                                            ! ---------------------------------------- !
-      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
-         !                                         ! ---------------------------------------- !
-         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields
-         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
-         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
-         emp_b (:,:) = emp (:,:)
-         sfx_b (:,:) = sfx (:,:)
-         IF ( ln_rnf ) THEN
-            rnf_b    (:,:  ) = rnf    (:,:  )
-            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
-         ENDIF
-         IF( ln_isf )  THEN
-            fwfisf_b  (:,:  ) = fwfisf  (:,:  )               
-            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)              
-         ENDIF
-        !
-      ENDIF
-      !                                            ! ---------------------------------------- !
-      !                                            !        forcing field computation         !
-      !                                            ! ---------------------------------------- !
-      !
-      ll_sas = nn_components == jp_iam_sas               ! component flags
-      ll_opa = nn_components == jp_iam_opa
-      !
-      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
-      IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves
-
-      !
-      !                                            !==  sbc formulation  ==!
-      !                                                   
-      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
-      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
-      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb, Kmm )                   ! user defined formulation 
-      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation
-      CASE( jp_blk     )
-         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: SAS receiving fields from OPA
-                               CALL sbc_blk       ( kt )                             ! bulk formulation for the ocean
-                               !
-      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! pure coupled formulation
-      CASE( jp_none    )
-         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS
-      END SELECT
-      !
-      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing
-      !
-      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves 
-      !
-      !                                            !==  Misc. Options  ==!
-      !
-      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model)
-#if defined key_si3
-      CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model
-#endif
-      CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model
-      END SELECT
-
-      IF( ln_icebergs    )   THEN
-                                     CALL icb_stp( kt )           ! compute icebergs
-         ! icebergs may advect into haloes during the icb step and alter emp.
-         ! A lbc_lnk is necessary here to ensure restartability (#2113)
-         IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs
-      ENDIF
-
-      IF( ln_isf         )   CALL sbc_isf( kt, Kmm )                   ! compute iceshelves
-
-      IF( ln_rnf         )   CALL sbc_rnf( kt )                        ! add runoffs to fresh water fluxes
-
-      IF( ln_ssr         )   CALL sbc_ssr( kt )                        ! add SST/SSS damping term
-
-      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm )  ! control the freshwater budget
-
-      ! Special treatment of freshwater fluxes over closed seas in the model domain
-      ! Should not be run if ln_diurnal_only
-      IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) )   CALL sbc_clo( kt )   
-
-!!$!RBbug do not understand why see ticket 667
-!!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
-!!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
-      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
-         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
-         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
-                                                     ! depth above wd limit once
-         WHERE( zwdht(:,:) <= 0.0 )
-            taum(:,:) = 0.0
-            utau(:,:) = 0.0
-            vtau(:,:) = 0.0
-            qns (:,:) = 0.0
-            qsr (:,:) = 0.0
-            emp (:,:) = min(emp(:,:),0.0) !can allow puddles to grow but not shrink
-            sfx (:,:) = 0.0
-         END WHERE
-         zwght(:,:) = tanh(zthscl*zwdht(:,:))
-         WHERE( zwdht(:,:) > 0.0  .and. zwdht(:,:) < rn_wd_sbcdep ) !  5 m hard limit here is arbitrary
-            qsr  (:,:) =  qsr(:,:)  * zwght(:,:)
-            qns  (:,:) =  qns(:,:)  * zwght(:,:)
-            taum (:,:) =  taum(:,:) * zwght(:,:)
-            utau (:,:) =  utau(:,:) * zwght(:,:)
-            vtau (:,:) =  vtau(:,:) * zwght(:,:)
-            sfx  (:,:) =  sfx(:,:)  * zwght(:,:)
-            emp  (:,:) =  emp(:,:)  * zwght(:,:)
-         END WHERE
-      ENDIF
-      !
-      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
-         !                                             ! ---------------------------------------- !
-         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
-            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file'
-            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point)
-            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios  )   ! before non solar heat flux (T-point)
-            ! The 3D heat content due to qsr forcing is treated in traqsr
-            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, ldxios = lrxios  )    ! before     freshwater flux (T-point)
-            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6
-            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
-               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, ldxios = lrxios )  ! before salt flux (T-point)
-            ELSE
-               sfx_b (:,:) = sfx(:,:)
-            ENDIF
-         ELSE                                                   !* no restart: set from nit000 values
-            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
-            utau_b(:,:) = utau(:,:)
-            vtau_b(:,:) = vtau(:,:)
-            qns_b (:,:) = qns (:,:)
-            emp_b (:,:) = emp (:,:)
-            sfx_b (:,:) = sfx (:,:)
-         ENDIF
-      ENDIF
-      !                                                ! ---------------------------------------- !
-      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
-         !                                             ! ---------------------------------------- !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
-         IF( lwxios ) CALL iom_swap(      cwxios_context          )
-         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios )
-         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios )
-         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns, ldxios = lwxios  )
-         ! The 3D heat content due to qsr forcing is treated in traqsr
-         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
-         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp, ldxios = lwxios  )
-         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx, ldxios = lwxios  )
-         IF( lwxios ) CALL iom_swap(      cxios_context          )
-      ENDIF
-      !                                                ! ---------------------------------------- !
-      !                                                !        Outputs and control print         !
-      !                                                ! ---------------------------------------- !
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux
-         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
-         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)
-         CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux
-         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux
-         CALL iom_put( "qns"   , qns        )                   ! solar heat flux
-         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux
-         IF( nn_ice > 0 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction
-         CALL iom_put( "taum"  , taum       )                   ! wind stress module
-         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
-      ENDIF
-      !
-      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at each time step in sea-ice)
-      CALL iom_put( "vtau", vtau )   ! j-wind stress
-      !
-      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i    - : ' , mask1=tmask )
-         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf)  , clinfo1=' emp-rnf - : ' , mask1=tmask )
-         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf)  , clinfo1=' sfx-rnf - : ' , mask1=tmask )
-         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask )
-         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask )
-         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk )
-         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      &
-            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask )
-      ENDIF
-
-      IF( kt == nitend )   CALL sbc_final         ! Close down surface module if necessary
-      !
-      IF( ln_timing )   CALL timing_stop('sbc')
-      !
-   END SUBROUTINE sbc
-
-
-   SUBROUTINE sbc_final
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE sbc_final  ***
-      !!
-      !! ** Purpose :   Finalize CICE (if used)
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_ice == 3 )   CALL cice_sbc_final
-      !
-   END SUBROUTINE sbc_final
-
-   !!======================================================================
-END MODULE sbcmod
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/stpctl.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/stpctl.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/stpctl.F90	(revision 13197)
@@ -19,12 +19,12 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE c1d             ! 1D vertical configuration
-   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables
-   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy
-   !  
    USE diawri          ! Standard run outputs       (dia_wri_state routine)
+   !
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! distributed memory computing
-   !
+   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables
+   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy
+
    USE netcdf          ! NetCDF library
    IMPLICIT NONE
@@ -33,6 +33,6 @@
    PUBLIC stp_ctl           ! routine called by step.F90
 
-   INTEGER                ::   nrunid   ! netcdf file id
-   INTEGER, DIMENSION(8)  ::   nvarid   ! netcdf variable id
+   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus
+   LOGICAL  ::   lsomeoce
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -42,5 +42,5 @@
 CONTAINS
 
-   SUBROUTINE stp_ctl( kt, Kmm )
+   SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE stp_ctl  ***
@@ -50,5 +50,5 @@
       !! ** Method  : - Save the time step in numstp
       !!              - Print it each 50 time steps
-      !!              - Stop the run IF problem encountered by setting nstop > 0
+      !!              - Stop the run IF problem encountered by setting indic=-3
       !!                Problems checked: |ssh| maximum larger than 10 m
       !!                                  |U|   maximum larger than 10 m/s 
@@ -57,251 +57,143 @@
       !! ** Actions :   "time.step" file = last ocean time-step
       !!                "run.stat"  file = run statistics
-      !!                 nstop indicator sheared among all local domain
+      !!                nstop indicator sheared among all local domain (lk_mpp=T)
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index
+      INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index
+      INTEGER, INTENT(inout) ::   kindic   ! error indicator
       !!
-      INTEGER                         ::   ji                                    ! dummy loop indices
-      INTEGER                         ::   idtime, istatus
-      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax
-      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices
-      REAL(wp)                        ::   zzz                                   ! local real 
-      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal
-      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns
-      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk
-      CHARACTER(len=20)               ::   clname
+      INTEGER                ::   ji, jj, jk          ! dummy loop indices
+      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices
+      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices
+      REAL(wp)               ::   zzz                 ! local real 
+      REAL(wp), DIMENSION(9) ::   zmax
+      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
+      CHARACTER(len=20) :: clname
       !!----------------------------------------------------------------------
-      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid
-      !
-      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
-      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 
-      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
-      !
-      IF( kt == nit000 ) THEN
-         !
-         IF( lwp ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'stp_ctl : time-stepping control'
-            WRITE(numout,*) '~~~~~~~'
-         ENDIF
-         !                                ! open time.step    ascii file, done only by 1st subdomain
-         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-         !
-         IF( ll_wrtruns ) THEN
-            !                             ! open run.stat     ascii file, done only by 1st subdomain
+      !
+      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
+      ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat )
+      ll_wrtruns = ll_colruns .AND. lwm
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         !                                ! open time.step file
+         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         !                                ! open run.stat file(s) at start whatever
+         !                                ! the value of sn_cfctl%ptimincr
+         IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN
             CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain
             clname = 'run.stat.nc'
             IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
-            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid )
-            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime )
-            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) )
-            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) )
-            istatus = NF90_DEF_VAR( nrunid,       's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) )
-            istatus = NF90_DEF_VAR( nrunid,       's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) )
-            istatus = NF90_DEF_VAR( nrunid,       't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) )
-            istatus = NF90_DEF_VAR( nrunid,       't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) )
+            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun )
+            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )
+            istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh )
+            istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   )
+            istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1  )
+            istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2  )
+            istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1  )
+            istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2  )
             IF( ln_zad_Aimp ) THEN
-               istatus = NF90_DEF_VAR( nrunid,   'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) )
-               istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) )
+               istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1  )
+               istatus = NF90_DEF_VAR( idrun,       'Cf_max', NF90_DOUBLE, (/ idtime /), idc1  )
             ENDIF
-            istatus = NF90_ENDDEF(nrunid)
-         ENDIF
-         !    
-      ENDIF
-      !
-      !                                   !==              write current time step              ==!
-      !                                   !==  done only by 1st subdomain at writting timestep  ==!
-      IF( lwm .AND. ll_wrtstp ) THEN
+            istatus = NF90_ENDDEF(idrun)
+            zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use
+         ENDIF
+      ENDIF
+      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0
+      !
+      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file)
          WRITE ( numstp, '(1x, i8)' )   kt
          REWIND( numstp )
       ENDIF
-      !                                   !==            test of local extrema           ==!
-      !                                   !==  done by all processes at every time step  ==!
-      !
-      ! define zmax default value. needed for land processors
-      IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible
-         zmax(:) = -HUGE(1._wp)
-      ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...)
-         zmax(:) =  0._wp
-         zmax(3) = -1._wp      ! avoid salinity minimum at 0.
-      ENDIF
-      !
-      llmsk(:,:,1) = ssmask(:,:) == 1._wp
-      IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors...
-         IF( ll_wd ) THEN
-            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max
-         ELSE
-            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max
-         ENDIF
-      ENDIF
-      zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only)
-      llmsk(:,:,:) = tmask(:,:,:) == 1._wp
-      IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors...
-         zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max
-         zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max
-         IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file
-            zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max
-            zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max
-            IF( ln_zad_Aimp ) THEN
-               zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max
-               llmsk(:,:,:) = wmask(:,:,:) == 1._wp
-               IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors...
-                  zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max
-               ENDIF
-            ENDIF
-         ENDIF
-      ENDIF
-      zmax(9) = REAL( nstop, wp )                                              ! stop indicator
-      !                                   !==               get global extrema             ==!
-      !                                   !==  done by all processes if writting run.stat  ==!
+      !
+      !                                   !==  test of extrema  ==!
+      IF( ll_wd ) THEN
+         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max 
+      ELSE
+         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max
+      ENDIF
+      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only)
+      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max
+      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max
+      zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max
+      zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max
+      zmax(7) = REAL( nstop , wp )                                            ! stop indicator
+      IF( ln_zad_Aimp ) THEN
+         zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max
+         zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) ! partitioning coeff. max
+      ENDIF
+      !
       IF( ll_colruns ) THEN
-         zmaxlocal(:) = zmax(:)
          CALL mpp_max( "stpctl", zmax )          ! max over the global domain
-         nstop = NINT( zmax(9) )                 ! update nstop indicator (now sheared among all local domains)
-      ENDIF
-      !                                   !==              write "run.stat" files              ==!
-      !                                   !==  done only by 1st subdomain at writting timestep  ==!
+         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains
+      ENDIF
+      !                                   !==  run statistics  ==!   ("run.stat" files)
       IF( ll_wrtruns ) THEN
          WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4)
-         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) )
-         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) )
-         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) )
-         istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) )
-         istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) )
-         istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) )
+         istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) )
          IF( ln_zad_Aimp ) THEN
-            istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) )
-            istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) )
-         ENDIF
-         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid)
+            istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) )
+            istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) )
+         ENDIF
+         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun)
+         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun)
       END IF
-      !                                   !==               error handling               ==!
-      !                                   !==  done by all processes at every time step  ==!
-      !
-      IF(   zmax(1) >   20._wp .OR.   &                   ! too large sea surface height ( > 20 m )
-         &  zmax(2) >   10._wp .OR.   &                   ! too large velocity ( > 10 m/s)
-!!$         &  zmax(3) >=   0._wp .OR.   &                   ! negative or zero sea surface salinity
-!!$         &  zmax(4) >= 100._wp .OR.   &                   ! too large sea surface salinity ( > 100 )
-!!$         &  zmax(4) <    0._wp .OR.   &                   ! too large sea surface salinity (keep this line for sea-ice)
-         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests
-         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests
+      !                                   !==  error handling  ==!
+      IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges
+         &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m )
+         &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s)
+!!$         &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity
+!!$         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 )
+!!$         &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
+         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
+         IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN
+            ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed)
+            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  )
+            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  )
+            CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 )
+            CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 )
+         ELSE
+            ! find local min and max locations
+            ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
+            iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
+            is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
+            is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
+         ENDIF
+         
+         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests'
+         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2)
+         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
+         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
+         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
+         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
+         
+         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
+         
+         IF( .NOT. sn_cfctl%l_glochk ) THEN
+            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
+            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
+         ELSE
+            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )
+         ENDIF
+
+         kindic = -3
          !
-         iloc(:,:) = 0
-         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc
-            ! first: close the netcdf file, so we can read it
-            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid)
-            ! get global loc on the min/max
-            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F 
-            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)),  umask(:,:,:), zzz, iloc(1:3,2) )
-            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,3) )
-            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) )
-            ! find which subdomain has the max.
-            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0
-            DO ji = 1, 9
-               IF( zmaxlocal(ji) == zmax(ji) ) THEN
-                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1
-               ENDIF
-            END DO
-            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain
-            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain
-            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain
-         ELSE                    ! find local min and max locations:
-            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc
-            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /)
-            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
-            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
-            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
-            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information
-         ENDIF
-         !
-         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests'
-         CALL wrt_line( ctmp2, kt, '|ssh| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) )
-         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) )
-         CALL wrt_line( ctmp4, kt, 'Sal   min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) )
-         CALL wrt_line( ctmp5, kt, 'Sal   max',  zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) )
-         IF( Agrif_Root() ) THEN
-            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files'
-         ELSE
-            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files'
-         ENDIF
-         !
-         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
-         !
-         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files
-            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 )
-            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop)
-            ENDIF
-         ELSE                                    ! only mpi subdomains with errors are here -> STOP now
-            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 )
-         ENDIF
-         !
-      ENDIF
-      !
-      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet...
-         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error
-         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock
-      ENDIF
-      !
+      ENDIF
+      !
+9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
+9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
+9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5)
+9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5)
 9500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16)
       !
    END SUBROUTINE stp_ctl
-
-
-   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE wrt_line  ***
-      !!
-      !! ** Purpose :   write information line
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*),      INTENT(  out) ::   cdline
-      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix
-      REAL(wp),              INTENT(in   ) ::   pval
-      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc
-      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax
-      !
-      CHARACTER(len=80) ::   clsuff
-      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax
-      CHARACTER(len=9 ) ::   cli, clj, clk
-      CHARACTER(len=1 ) ::   clfmt
-      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why
-      INTEGER           ::   ifmtk
-      !!----------------------------------------------------------------------
-      WRITE(clkt , '(i9)') kt
-      
-      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9)
-      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF
-      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum
-      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9)
-      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1
-                                   WRITE(clmax, cl4) kmax-1
-      !
-      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9)
-      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF
-      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9)
-      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF
-      !
-      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin)
-      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax)
-      ENDIF
-      IF(kloc(3) == 0) THEN
-         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9)
-         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string
-         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff)
-      ELSE
-         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9)
-         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF
-         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF
-         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff)
-      ENDIF
-      !
-9100  FORMAT('MPI rank ', a)
-9200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a)
-9300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a)
-9400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a)
-      !
-   END SUBROUTINE wrt_line
-
 
    !!======================================================================
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/trazdf.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/trazdf.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/trazdf.F90	(revision 13197)
@@ -35,4 +35,6 @@
    PUBLIC   tra_zdf_imp   ! called by trczdf.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -77,5 +79,5 @@
       ! JMM avoid negative salinities near river outlet ! Ugly fix
       ! JMM : restore negative salinities to small salinities:
-!!$   WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp
+!!$      WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp
 !!gm
 
@@ -95,6 +97,6 @@
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop('tra_zdf')
@@ -154,19 +156,11 @@
             IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
                IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 2, jpkm1 )
+                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
+                  END_3D
                ELSE                          ! standard or triad iso-neutral operator
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 2, jpkm1 )
+                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+                  END_3D
                ENDIF
             ENDIF
@@ -174,26 +168,18 @@
             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
             IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.)
-                        zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm)
-                        zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
-                        zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   &
-                           &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )
-                        zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp )
-                        zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp )
-                    END DO
-                  END DO
-               END DO
+               DO_3D_00_00( 1, jpkm1 )
+                  zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm)
+                  zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   &
+                     &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )
+                  zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp )
+                  zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp )
+               END_3D
             ELSE
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm)
-                        zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
-                        zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk)
-                    END DO
-                  END DO
-               END DO
+               DO_3D_00_00( 1, jpkm1 )
+                  zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm)
+                  zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk)
+               END_3D
             ENDIF
             !
@@ -217,46 +203,28 @@
             !   used as a work space array: its value is modified.
             !
-            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
-                  zwt(ji,jj,1) = zwd(ji,jj,1)
-               END DO
-            END DO
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
-                  END DO
-               END DO
-            END DO
+            DO_2D_00_00
+               zwt(ji,jj,1) = zwd(ji,jj,1)
+            END_2D
+            DO_3D_00_00( 2, jpkm1 )
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+            END_3D
             !
          ENDIF 
          !         
-         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-            DO ji = fs_2, fs_jpim1
-               pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side
-                  pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa)
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)
+         END_2D
+         DO_3D_00_00( 2, jpkm1 )
+            zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side
+            pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa)
+         END_3D
          !
-         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
-            DO ji = fs_2, fs_jpim1
-               pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-            END DO
-         END DO
-         DO jk = jpk-2, 1, -1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   &
-                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+         END_2D
+         DO_3DS_00_00( jpk-2, 1, -1 )
+            pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   &
+               &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+         END_3D
          !                                            ! ================= !
       END DO                                          !  end tracer loop  !
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -88,20 +90,18 @@
 #endif
          
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
-            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
-
-            plamt(ji,jj) = zlam0 + rn_dx * zti
-            plamu(ji,jj) = zlam0 + rn_dx * zui
-            plamv(ji,jj) = plamt(ji,jj) 
-            plamf(ji,jj) = plamu(ji,jj) 
-   
-            pphit(ji,jj) = zphi0 + rn_dy * ztj
-            pphiv(ji,jj) = zphi0 + rn_dy * zvj
-            pphiu(ji,jj) = pphit(ji,jj) 
-            pphif(ji,jj) = pphiv(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
+         zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
+         
+         plamt(ji,jj) = zlam0 + rn_dx * zti
+         plamu(ji,jj) = zlam0 + rn_dx * zui
+         plamv(ji,jj) = plamt(ji,jj) 
+         plamf(ji,jj) = plamu(ji,jj) 
+         
+         pphit(ji,jj) = zphi0 + rn_dy * ztj
+         pphiv(ji,jj) = zphi0 + rn_dy * zvj
+         pphiu(ji,jj) = pphit(ji,jj) 
+         pphif(ji,jj) = pphiv(ji,jj) 
+      END_2D
       !     
       ! Horizontal scale factors (in meters)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_istate.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_istate.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_istate.F90	(revision 13197)
@@ -28,4 +28,6 @@
    PUBLIC   usr_def_istate   ! called by istate.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -164,9 +166,7 @@
          pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1)
          DO jl=1, jpnj
-            DO jj=nldj, nlej
-               DO ji=nldi, nlei
-                  pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj)
+            END_2D
             CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. )
          END DO
@@ -183,29 +183,26 @@
       CASE(4)    ! geostrophic zonal pulse
    
-         DO jj=1, jpj
-            DO ji=1, jpi
-               IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN
-                  zdu = rn_uzonal
-               ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN
-                  zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. )
-               ELSE
-                  zdu = 0.
-               END IF
-               IF ( ABS(gphit(ji,jj)) <= zjety ) THEN
-                  pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav
-                  pu(ji,jj,:) = zdu
-                  pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1.
-               ELSE
-                  pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 
-                  pu(ji,jj,:) = 0.
-                  pts(ji,jj,:,jp_sal) = 1.
-               END IF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN
+               zdu = rn_uzonal
+            ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN
+               zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. )
+            ELSE
+               zdu = 0.
+            END IF
+            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN
+               pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav
+               pu(ji,jj,:) = zdu
+               pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1.
+            ELSE
+               pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 
+               pu(ji,jj,:) = 0.
+               pts(ji,jj,:,jp_sal) = 1.
+            END IF
+         END_2D
          
          ! temperature:
          pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)        
          pv(:,:,:) = 0.
-         
          
        CASE(5)    ! vortex
@@ -220,31 +217,29 @@
          zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp)
          !
-         DO jj=1, jpj
-            DO ji=1, jpi
-               zx = glamt(ji,jj) * 1.e3
-               zy = gphit(ji,jj) * 1.e3
-               ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y)
-               zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy
-               ! Sea level:
-               pssh(ji,jj) = 0.
-               DO jl=1,5
-                  zdt = pssh(ji,jj)
-                  zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z)
-                  zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)
-                  pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g)
-               END DO
-               ! temperature:
-               DO jk=1,jpk
-                  zdt =  pdept(ji,jj,jk) 
-                  zrho1 = rho0 * (1._wp + zn2*zdt/grav)
-                  IF (zdt < zH) THEN
-                     zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH))   ! F'(z)
-                     zrho1 = zrho1 - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)
-                  ENDIF
-                  !               pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
-                  pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_2D_11_11
+            zx = glamt(ji,jj) * 1.e3
+            zy = gphit(ji,jj) * 1.e3
+            ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y)
+            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy
+            ! Sea level:
+            pssh(ji,jj) = 0.
+            DO jl=1,5
+               zdt = pssh(ji,jj)
+               zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z)
+               zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)
+               pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g)
+            END DO
+            ! temperature:
+            DO jk=1,jpk
+               zdt =  pdept(ji,jj,jk) 
+               zrho1 = rho0 * (1._wp + zn2*zdt/grav)
+               IF (zdt < zH) THEN
+                  zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH))   ! F'(z)
+                  zrho1 = zrho1 - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)
+               ENDIF
+               !               pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
+               pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
+            END DO
+         END_2D
          !
          ! salinity:  
@@ -253,40 +248,36 @@
          ! velocities:
          za = 2._wp * zP0 / zlambda**2
-         DO jj=1, jpj
-            DO ji=1, jpim1
-               zx = glamu(ji,jj) * 1.e3
-               zy = gphiu(ji,jj) * 1.e3
-               DO jk=1, jpk
-                  zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk))
-                  IF (zdu < zH) THEN
-                     zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH))
-                     zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal
-                     pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk)
-                  ELSE
-                     pu(ji,jj,jk) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         DO jj=1, jpjm1
-            DO ji=1, jpi
-               zx = glamv(ji,jj) * 1.e3
-               zy = gphiv(ji,jj) * 1.e3
-               DO jk=1, jpk
-                  zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk))
-                  IF (zdv < zH) THEN
-                     zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH))
-                     zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2)
-                     pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk)
-                  ELSE
-                     pv(ji,jj,jk) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            zx = glamu(ji,jj) * 1.e3
+            zy = gphiu(ji,jj) * 1.e3
+            DO jk=1, jpk
+               zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk))
+               IF (zdu < zH) THEN
+                  zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH))
+                  zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal
+                  pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk)
+               ELSE
+                  pu(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END_2D
+         !
+         DO_2D_00_00
+            zx = glamv(ji,jj) * 1.e3
+            zy = gphiv(ji,jj) * 1.e3
+            DO jk=1, jpk
+               zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk))
+               IF (zdv < zH) THEN
+                  zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH))
+                  zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2)
+                  pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk)
+               ELSE
+                  pv(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END_2D
          !            
       END SELECT
-
+      
       IF (ln_sshnoise) THEN
          CALL RANDOM_NUMBER(zrandom)
@@ -294,7 +285,6 @@
       END IF
       CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. )
-      CALL lbc_lnk(  'usrdef_istate', pts, 'T',  1. )
-      CALL lbc_lnk(   'usrdef_istate', pu, 'U', -1. )
-      CALL lbc_lnk(   'usrdef_istate', pv, 'V', -1. )
+      CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. )
+      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
 
    END SUBROUTINE usr_def_istate
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_sbc.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_sbc.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_sbc.F90	(revision 13197)
@@ -38,5 +38,5 @@
 CONTAINS
 
-   SUBROUTINE usrdef_sbc_oce( kt, Kmm, Kbb )
+   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE usr_def_sbc  ***
@@ -53,5 +53,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt        ! ocean time step
-      INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time index
+      INTEGER, INTENT(in) ::   Kbb       ! ocean time index
       INTEGER  ::   ji, jj               ! dummy loop indices
       REAL(wp) :: zrhoair = 1.22     ! approximate air density [Kg/m3]
@@ -86,11 +86,11 @@
          
          WHERE( ABS(gphit) <= rn_windszy/2. )
-            zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kmm)
+            zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kbb)
          ELSEWHERE
-            zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kmm)
+            zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kbb)
          END WHERE
          utau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:)
 
-         zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kmm)
+         zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kbb)
          vtau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:)
 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -204,5 +204,5 @@
       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
       !
-      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere
+      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere
       !
       k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -76,20 +78,18 @@
       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
-            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
-
-            plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
-            plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
-            plamv(ji,jj) = plamt(ji,jj) 
-            plamf(ji,jj) = plamu(ji,jj) 
-   
-            pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
-            pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
-            pphiu(ji,jj) = pphit(ji,jj) 
-            pphif(ji,jj) = pphiv(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
+         zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
+         
+         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
+         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
+         plamv(ji,jj) = plamt(ji,jj) 
+         plamf(ji,jj) = plamu(ji,jj) 
+         
+         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
+         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
+         pphiu(ji,jj) = pphit(ji,jj) 
+         pphif(ji,jj) = pphiv(ji,jj) 
+      END_2D
          
       ! constant scale factors
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -88,20 +90,18 @@
 #endif         
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
-            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
-
-            plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
-            plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
-            plamv(ji,jj) = plamt(ji,jj) 
-            plamf(ji,jj) = plamu(ji,jj) 
-   
-            pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
-            pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
-            pphiu(ji,jj) = pphit(ji,jj) 
-            pphif(ji,jj) = pphiv(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
+         zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
+         
+         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
+         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
+         plamv(ji,jj) = plamt(ji,jj) 
+         plamf(ji,jj) = plamu(ji,jj) 
+         
+         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
+         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
+         pphiu(ji,jj) = pphit(ji,jj) 
+         pphif(ji,jj) = pphiv(ji,jj) 
+      END_2D
          
          ! Horizontal scale factors (in meters)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90	(revision 13197)
@@ -14,5 +14,5 @@
    !!   usr_def_hgr   : initialize the horizontal mesh 
    !!----------------------------------------------------------------------
-   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE dom_oce  , ONLY: nimpp , njmpp, Agrif_Root            ! i- & j-indices of the local domain
    USE par_oce        ! ocean space and time domain
    USE phycst         ! physical constants
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -88,20 +90,18 @@
 #endif         
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
-            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
-
-            plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
-            plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
-            plamv(ji,jj) = plamt(ji,jj) 
-            plamf(ji,jj) = plamu(ji,jj) 
-   
-            pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
-            pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
-            pphiu(ji,jj) = pphit(ji,jj) 
-            pphif(ji,jj) = pphiv(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
+         zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
+         
+         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
+         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
+         plamv(ji,jj) = plamt(ji,jj) 
+         plamf(ji,jj) = plamu(ji,jj) 
+         
+         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
+         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
+         pphiu(ji,jj) = pphit(ji,jj) 
+         pphif(ji,jj) = pphiv(ji,jj) 
+      END_2D
          
          ! Horizontal scale factors (in meters)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90	(revision 13197)
@@ -89,5 +89,5 @@
          kpj = nbcellsy + 2 + 2*nbghostcells
       ENDIF
-      kpk = 1
+      kpk = 2
       !
 !!      zlx = (kpi-2)*rn_dx*1.e-3
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -89,5 +89,5 @@
       !                       !==  z-coordinate  ==!   (step-like topography)
       !                                !* bottom ocean compute from the depth of grid-points
-      jpkm1 = jpk
+      jpkm1 = jpk-1
       k_bot(:,:) = 1    ! here use k_top as a land mask
       !                                !* horizontally uniform coordinate (reference z-co everywhere)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -27,4 +27,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -75,33 +77,30 @@
       !
       !                       !==  grid point position  ==!   (in degrees)
-      DO jj = 1, jpj
-         DO ji = 1, jpi             ! longitude   (west coast at lon=0°)
-            plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
-            plamu(ji,jj) = rn_e1deg * (          REAL( ji-1 + nimpp-1 , wp )  )
-            plamv(ji,jj) = plamt(ji,jj)
-            plamf(ji,jj) = plamu(ji,jj)
-            !                       ! latitude   (south coast at lat= 81°)
-            pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) - 80._wp
-            pphiu(ji,jj) = pphit(ji,jj)
-            pphiv(ji,jj) = rn_e2deg * (          REAL( jj-1 + njmpp-1 , wp )  ) - 80_wp
-            pphif(ji,jj) = pphiv(ji,jj)
-         END DO
-      END DO
+      DO_2D_11_11
+         !                       ! longitude   (west coast at lon=0°)
+         plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+         plamu(ji,jj) = rn_e1deg * (          REAL( ji-1 + nimpp-1 , wp )  )
+         plamv(ji,jj) = plamt(ji,jj)
+         plamf(ji,jj) = plamu(ji,jj)
+         !                       ! latitude   (south coast at lat= 81°)
+         pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) - 80._wp
+         pphiu(ji,jj) = pphit(ji,jj)
+         pphiv(ji,jj) = rn_e2deg * (          REAL( jj-1 + njmpp-1 , wp )  ) - 80_wp
+         pphif(ji,jj) = pphiv(ji,jj)
+      END_2D
       !
       !                       !==  Horizontal scale factors  ==!   (in meters)
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !                       ! e1   (zonal)
-            pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg
-            pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg
-            pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg
-            pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg
-            !                       ! e2   (meridional)
-            pe2t(ji,jj) = ra * rad * rn_e2deg
-            pe2u(ji,jj) = ra * rad * rn_e2deg
-            pe2v(ji,jj) = ra * rad * rn_e2deg
-            pe2f(ji,jj) = ra * rad * rn_e2deg
-         END DO
-      END DO
+      DO_2D_11_11
+         !                       ! e1   (zonal)
+         pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg
+         pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg
+         pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg
+         pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg
+         !                       ! e2   (meridional)
+         pe2t(ji,jj) = ra * rad * rn_e2deg
+         pe2u(ji,jj) = ra * rad * rn_e2deg
+         pe2v(ji,jj) = ra * rad * rn_e2deg
+         pe2f(ji,jj) = ra * rad * rn_e2deg
+      END_2D
       !                             ! NO reduction of grid size in some straits 
       ke1e2u_v    = 0               !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -30,4 +30,6 @@
    PUBLIC   usr_def_zgr   ! called by domzgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -132,48 +134,43 @@
             pe3vw(:,:,jk) = pe3w_1d (jk)
          END DO
-         DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points
-            DO ji = 1, jpi
-               ik = k_top(ji,jj)
-               IF ( ik > 2 ) THEN
-                  ! pdeptw at the interface
-                  pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) )
-                  ! e3t in both side of the interface
-                  pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
-                  ! pdept in both side of the interface (from previous e3t)
-                  pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
-                  pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp
-                  ! pe3w on both side of the interface
-                  pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  )
-                  pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)
-                  ! e3t into the ice shelf
-                  pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1)
-                  pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2)
-               END IF
-            END DO
-         END DO         
-         DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
-            DO ji = 1, jpi
-               ik = k_bot(ji,jj)
-               pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+         ! top scale factors and depth at T- and W-points
+         DO_2D_11_11
+            ik = k_top(ji,jj)
+            IF ( ik > 2 ) THEN
+               ! pdeptw at the interface
+               pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) )
+               ! e3t in both side of the interface
                pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
-               pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
-               !
+               ! pdept in both side of the interface (from previous e3t)
                pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
-               pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
-               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)
-            END DO
-         END DO         
+               pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp
+               ! pe3w on both side of the interface
+               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  )
+               pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)
+               ! e3t into the ice shelf
+               pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1)
+               pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2)
+            END IF
+         END_2D
+         ! bottom scale factors and depth at T- and W-points
+         DO_2D_11_11
+            ik = k_bot(ji,jj)
+            pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+            pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+            pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
+            !
+            pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
+            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)
+         END_2D       
          !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points
          pe3u (:,:,:) = pe3t(:,:,:)
          pe3uw(:,:,:) = pe3w(:,:,:)
-         DO jk = 1, jpk                      ! Computed as the minimum of neighbooring scale factors
-            DO jj = 1, jpjm1
-               DO ji = 1, jpi
-                  pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
-                  pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
-                  pe3f (ji,jj,jk) = pe3v(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpk )
+         !                                   ! Computed as the minimum of neighbooring scale factors
+            pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
+            pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
+            pe3f (ji,jj,jk) = pe3v(ji,jj,jk)
+         END_3D
          CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp )
          CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp )
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -72,17 +74,16 @@
       !                       !==  grid point position  ==!   (in kilometers)
       zfact = rn_dx * 1.e-3         ! conversion in km
-      DO jj = 1, jpj
-         DO ji = 1, jpi             ! longitude
-            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
-            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
-            plamv(ji,jj) = plamt(ji,jj)
-            plamf(ji,jj) = plamu(ji,jj)
-            !                       ! latitude
-            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
-            pphiu(ji,jj) = pphit(ji,jj)
-            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
-            pphif(ji,jj) = pphiv(ji,jj)
-         END DO
-      END DO
+      DO_2D_11_11
+         !                       ! longitude
+         plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+         plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+         plamv(ji,jj) = plamt(ji,jj)
+         plamf(ji,jj) = plamu(ji,jj)
+         !                       ! latitude
+         pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+         pphiu(ji,jj) = pphit(ji,jj)
+         pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+         pphif(ji,jj) = pphiv(ji,jj)
+      END_2D
       !
       !                       !==  Horizontal scale factors  ==!   (in meters) 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -72,17 +74,16 @@
       !                       !==  grid point position  ==!   (in kilometers)
       zfact = rn_dx * 1.e-3         ! conversion in km
-      DO jj = 1, jpj
-         DO ji = 1, jpi             ! longitude
-            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
-            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
-            plamv(ji,jj) = plamt(ji,jj)
-            plamf(ji,jj) = plamu(ji,jj)
-            !                       ! latitude
-            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
-            pphiu(ji,jj) = pphit(ji,jj)
-            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
-            pphif(ji,jj) = pphiv(ji,jj)
-         END DO
-      END DO
+      DO_2D_11_11
+         !                       ! longitude
+         plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+         plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+         plamv(ji,jj) = plamt(ji,jj)
+         plamf(ji,jj) = plamu(ji,jj)
+         !                       ! latitude
+         pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+         pphiu(ji,jj) = pphit(ji,jj)
+         pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+         pphif(ji,jj) = pphiv(ji,jj)
+      END_2D
       !
       !                       !==  Horizontal scale factors  ==!   (in meters) 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -29,4 +29,6 @@
    PUBLIC   usr_def_zgr   ! called by domzgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -182,16 +184,14 @@
             pe3vw(:,:,jk) = pe3w_1d (jk)
          END DO
-         DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
-            DO ji = 1, jpi
-               ik = k_bot(ji,jj)
-                  pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
-                  pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
-                  pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
-                  !
-                  pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
-                  pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
-                  pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  )
-            END DO
-         END DO         
+         DO_2D_11_11
+            ik = k_bot(ji,jj)
+            pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+            pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+            pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
+            !
+            pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
+            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  )
+         END_2D         
          !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points
          !                                   ! usually Computed as the minimum of neighbooring scale factors
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/launch_sasf.sh
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/launch_sasf.sh	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/launch_sasf.sh	(revision 13197)
@@ -1,78 +1,50 @@
 #!/bin/bash
 
-################################################################
-#
-# Script to launch a set of STATION_ASF simulations
-#
-# L. Brodeau, 2020
-#
-################################################################
+# NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup:
+NEMO_DIR=`pwd | sed -e "s|/tests/STATION_ASF/EXPREF||g"`
 
-# What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ?
+echo "Using NEMO_DIR=${NEMO_DIR}"
+
+# what directory inside "tests" actually contains the compiled test-case?
 TC_DIR="STATION_ASF2"
 
-# DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings
+# => so the executable to use is:
+NEMO_EXE="${NEMO_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe"
+
+# Directory where to run the simulation:
+WORK_DIR="${HOME}/tmp/STATION_ASF"
+
+
+# FORC_DIR => Directory containing sea-surface + atmospheric forcings
 #             (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/):
 if [ `hostname` = "merlat"        ]; then
-    DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018"
+    FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018"
 elif [ `hostname` = "luitel"        ]; then
-    DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018"
+    FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018"
 elif [ `hostname` = "ige-meom-cal1" ]; then
-    DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018"
+    FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018"
 elif [ `hostname` = "salvelinus" ]; then
-    DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018"
+    FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018"
 else
-    echo "Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit 
+    echo "Boo!"; exit
 fi
-
-expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally...
-
-# NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup:
-NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"`
-
-# Directory where to run the simulation:
-PROD_DIR="${HOME}/tmp/STATION_ASF"
+#======================
+mkdir -p ${WORK_DIR}
 
 
-####### End of normal user configurable section #######
+if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi
 
-#================================================================================
-
-# NEMO executable to use is:
-NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe"
-
-
-echo "###########################################################"
-echo "#        S T A T I O N   A i r  -  S e a   F l u x        #"
-echo "###########################################################"
-echo
-echo " We shall work in here: ${STATION_ASF_DIR}/"
-echo " NEMOGCM   work    depository is: ${NEMO_WRK_DIR}/"
-echo "   ==> NEMO EXE to use: ${NEMO_EXE}"
-echo " Input forcing data into: ${DATA_IN_DIR}/"
-echo " Production will be done into: ${PROD_DIR}/"
-echo
-
-mkdir -p ${PROD_DIR}
-
-if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi
-
-echo
-echo " *** Using the following NEMO executable:"
-echo "  ${NEMO_EXE} "
-echo
-
-NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF"
+NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF"
 if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi
 
-rsync -avP ${NEMO_EXE}          ${PROD_DIR}/
+rsync -avP ${NEMO_EXE}          ${WORK_DIR}/
 
 for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do
     if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi
-    rsync -avPL ${NEMO_EXPREF}/${ff} ${PROD_DIR}/
+    rsync -avPL ${NEMO_EXPREF}/${ff} ${WORK_DIR}/
 done
 
 # Copy forcing to work directory:
-rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/
+rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/
 
 for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do
@@ -86,8 +58,8 @@
     scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'`
 
-    rm -f ${PROD_DIR}/namelist_cfg
-    rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg
+    rm -f ${WORK_DIR}/namelist_cfg
+    rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg
 
-    cd ${PROD_DIR}/
+    cd ${WORK_DIR}/
     echo
     echo "Launching NEMO !"
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg	(revision 13197)
@@ -35,6 +35,6 @@
    nn_time0    =       0   !  initial time of day in hhmm
    nn_leapy    =       1   !  Leap year calendar (1) or not (0)
-   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T)
-      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T)
       nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T
       !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg	(revision 13197)
@@ -35,6 +35,6 @@
    nn_time0    =       0   !  initial time of day in hhmm
    nn_leapy    =       1   !  Leap year calendar (1) or not (0)
-   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T)
-      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T)
       nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T
       !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg	(revision 13197)
@@ -35,6 +35,6 @@
    nn_time0    =       0   !  initial time of day in hhmm
    nn_leapy    =       1   !  Leap year calendar (1) or not (0)
-   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T)
-      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T)
       nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T
       !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg	(revision 13197)
@@ -35,6 +35,6 @@
    nn_time0    =       0   !  initial time of day in hhmm
    nn_leapy    =       1   !  Leap year calendar (1) or not (0)
-   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T)
-      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T)
       nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T
       !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ncar_cfg
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ncar_cfg	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ncar_cfg	(revision 13197)
@@ -35,6 +35,6 @@
    nn_time0    =       0   !  initial time of day in hhmm
    nn_leapy    =       1   !  Leap year calendar (1) or not (0)
-   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T)
-      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T)
       nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T
       !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/plot_station_asf.py
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/plot_station_asf.py	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/plot_station_asf.py	(revision 13197)
@@ -53,6 +53,6 @@
 L_VARL  = [ r'$Q_{lat}$', r'$Q_{sens}$' , r'$Q_{net}$' , r'$Q_{lw}$' , r'$|\tau|$' , r'$\Delta T_{skin}$' ] ; # name of variable in latex mode
 L_VUNT  = [ r'$W/m^2$'  , r'$W/m^2$'    , r'$W/m^2$'   , r'$W/m^2$'  , r'$N/m^2$'  ,      'K'             ]
-L_VMAX  = [     75.     ,     75.       ,    800.      ,     25.     ,    1.2      ,      -0.7            ]
-L_VMIN  = [   -250.     ,   -125.       ,   -400.      ,   -150.     ,    0.       ,       0.7            ]
+L_VMAX  = [     75.     ,     75.       ,    800.      ,     25.     ,    1.2      ,       0.7            ]
+L_VMIN  = [   -250.     ,   -125.       ,   -400.      ,   -150.     ,    0.       ,      -0.7            ]
 L_ANOM  = [   True      ,    True       ,    True      ,    True     ,   True      ,      False           ]
 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/diawri.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/diawri.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/diawri.F90	(revision 13197)
@@ -35,4 +35,5 @@
    USE iom            !
    USE ioipsl         !
+
 #if defined key_si3
    USE ice
@@ -56,6 +57,6 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/SAS 4.0 , NEMO Consortium (2018)
-   !! $Id: diawri.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: diawri.F90 12493 2020-03-02 07:56:31Z smasson $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -114,11 +115,16 @@
       INTEGER, DIMENSION(2) :: ierr
       !!----------------------------------------------------------------------
-      ierr = 0
-      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
-         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
-         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
-      !
-      dia_wri_alloc = MAXVAL(ierr)
-      CALL mpp_sum( 'diawri', dia_wri_alloc )
+      IF( nn_write == -1 ) THEN
+         dia_wri_alloc = 0
+      ELSE
+         ierr = 0
+         ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
+            &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
+            &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
+         !
+         dia_wri_alloc = MAXVAL(ierr)
+         CALL mpp_sum( 'diawri', dia_wri_alloc )
+         !
+      ENDIF
       !
    END FUNCTION dia_wri_alloc
@@ -374,5 +380,5 @@
       CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
       CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
-         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
+      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
       CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
       CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/nemogcm.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/nemogcm.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/nemogcm.F90	(revision 13197)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE nemogcm   ***
-   !! StandAlone Surface module : surface fluxes
+   !!                      STATION_ASF (SAS meets C1D)
    !!======================================================================
    !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code
@@ -19,17 +19,16 @@
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module (step.F90)
-   USE sbc_oce        ! surface boundary condition: ocean #LB: rm?
    USE phycst         ! physical constant                  (par_cst routine)
    USE domain         ! domain initialization   (dom_init & dom_cfg routines)
    USE closea         ! treatment of closed seas (for ln_closea)
    USE usrdef_nam     ! user defined configuration
+   USE istate         ! initial state setting          (istate_init routine)
    USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices
    USE daymod         ! calendar
    USE restart        ! open  restart file
-   !LB:USE step           ! NEMO time-stepping                 (stp     routine)
    USE c1d            ! 1D configuration
    USE step_c1d       ! Time stepping loop for the 1D configuration
-   USE sbcssm         !
    !
+   USE in_out_manager ! I/O manager
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
@@ -49,5 +48,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: nemogcm.F90 11536 2019-09-11 13:54:18Z smasson $
+   !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -84,4 +83,7 @@
       !                            !==   time stepping   ==!
       !                            !-----------------------!
+      !
+      !                                               !== set the model time-step  ==!
+      !
       istp = nit000
       !
@@ -107,8 +109,7 @@
       !
 #if defined key_iomput
-      CALL xios_finalize  ! end mpp communications with xios
+                                    CALL xios_finalize  ! end mpp communications with xios
 #else
-      IF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications
-      ENDIF
+      IF( lk_mpp )                  CALL mppstop      ! end mpp communications
 #endif
       !
@@ -162,9 +163,15 @@
       IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open reference and configuration namelist files
-      CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
-      CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
+                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
+                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
       IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open /dev/null file to be able to supress output write easily
-      CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+      IF( Agrif_Root() ) THEN
+                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
       !
       !                             !--------------------!
@@ -222,5 +229,5 @@
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
-904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
       !
       IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file
@@ -253,26 +260,16 @@
       IF( ln_timing    )   CALL timing_start( 'nemo_init')
       !
-      CALL     phy_cst         ! Physical constants
-      CALL     eos_init        ! Equation of state
+                           CALL     phy_cst         ! Physical constants
+                           CALL     eos_init        ! Equation of state
       IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
-      CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
+                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
       IF( sn_cfctl%l_prtctl )   &
          &                 CALL prt_ctl_init        ! Print control
-
-      IF( ln_rstart ) THEN                    ! Restart from a file                                                                                 
-         !                                    ! -------------------                                                                                 
-         CALL rst_read( Nbb, Nnn )            ! Read the restart file                                                                               
-         CALL day_init                        ! model calendar (using both namelist and restart infos)                                              
-         !                                                                                                                                          
-      ELSE                                    ! Start from rest                                                                                     
-         !                                    ! ---------------                                                                                     
-         numror = 0                           ! define numror = 0 -> no restart file to read                                                        
-         neuler = 0                           ! Set time-step indicator at nit000 (euler forward)                                                   
-         CALL day_init                        ! model calendar (using both namelist and restart infos)                                              
-      ENDIF
-      !
-
-      !                                      ! external forcing
-      CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice)
+      !
+      
+                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers)
+
+      !                                      ! external forcing 
+                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice)
 
       !
@@ -305,8 +302,8 @@
          WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
          WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
-         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin
-         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax
-         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr
-         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr
+         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
+         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
+         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
+         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
@@ -423,5 +420,5 @@
       !!----------------------------------------------------------------------
       !
-      ierr =        oce_alloc    ()    ! ocean
+      ierr =        oce_alloc    ()    ! ocean 
       ierr = ierr + dia_wri_alloc()
       ierr = ierr + dom_oce_alloc()    ! ocean domain
@@ -432,5 +429,5 @@
    END SUBROUTINE nemo_alloc
 
-
+   
    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto )
       !!----------------------------------------------------------------------
@@ -456,2 +453,3 @@
    !!======================================================================
 END MODULE nemogcm
+
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/sbcssm.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/sbcssm.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/sbcssm.F90	(revision 13197)
@@ -54,5 +54,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/SAS 4.0 , NEMO Consortium (2018)
-   !! $Id: sbcssm.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
+   !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/step_c1d.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/step_c1d.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/step_c1d.F90	(revision 13197)
@@ -26,5 +26,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: step_c1d.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
+   !! $Id: step_c1d.F90 12377 2020-02-12 14:39:06Z acc $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -64,4 +64,7 @@
       CALL sbc    ( kstp, Nbb, Nnn )  ! Sea Boundary Condition (including sea-ice)
 
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       CALL dia_wri( kstp, Nnn )  ! ocean model: outputs
 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -14,5 +14,5 @@
    !!   usr_def_hgr   : initialize the horizontal mesh 
    !!----------------------------------------------------------------------
-   USE dom_oce  , ONLY: nimpp, njmpp        ! ocean space and time domain
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
    USE c1d      ,  ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist
    USE par_oce        ! ocean space and time domain
@@ -30,5 +30,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: usrdef_hgr.F90 10072 2018-08-28 15:21:50Z nicolasmartin $
+   !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $ 
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -54,5 +54,5 @@
       !!
       !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
-      !!              - define coriolis parameter at f-point if the domain in not on the sphere
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
       !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
       !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_nam.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_nam.F90	(revision 13197)
@@ -8,5 +8,5 @@
    !!======================================================================
    !! History :  4.0  ! 2016-03  (S. Flavoni, G. Madec)  Original code
-   !! History :  4.x  ! 2019-10  (L. Brodeau) for STATION_ASF (C1D meets SAS)
+   !!            4.x  ! 2019-10  (L. Brodeau) for STATION_ASF (C1D meets SAS)
    !!----------------------------------------------------------------------
 
@@ -15,6 +15,6 @@
    !!   usr_def_hgr   : initialize the horizontal mesh 
    !!----------------------------------------------------------------------
-   USE dom_oce  , ONLY: nimpp, njmpp             ! ocean space and time domain
-   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
+!!!   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate
    USE par_oce        ! ocean space and time domain
    USE phycst         ! physical constants
@@ -33,5 +33,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: usrdef_nam.F90 11536 2019-09-11 13:54:18Z smasson $ 
+   !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $ 
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -68,8 +68,8 @@
       kk_cfg = 0
 
-      ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 75 or vertical levels
+      ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 2 or vertical levels
       kpi = 3
       kpj = 3
-      kpk = 1
+      kpk = 2    ! 2, rather than 1, because 1 would cause some issues... like overflow in array boundary indexes, etc...
       !
       !                             ! Set the lateral boundary condition of the global domain
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -1,19 +1,21 @@
 MODULE usrdef_zgr
    !!======================================================================
-   !!                     ***  MODULE usrdef_zgr  ***
+   !!                       ***  MODULE  usrdef_zgr  ***
    !!
    !!                       ===  STATION_ASF case  ===
    !!
-   !! user defined :  vertical coordinate system of a user configuration
+   !! User defined : vertical coordinate system of a user configuration
    !!======================================================================
-   !! History :  4.0  ! 2019-10  (L. Brodeau)  Original code
+   !! History :  4.0  ! 2016-06  (G. Madec)  Original code
+   !!            4.x  ! 2019-10  (L. Brodeau) Station ASF
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!   usr_def_zgr   : user defined vertical coordinate system
+   !!      zgr_z      : reference 1D z-coordinate 
+   !!      zgr_top_bot: ocean top and bottom level indices
+   !!      zgr_zco    : 3D verticl coordinate in pure z-coordinate case
    !!---------------------------------------------------------------------
    USE oce            ! ocean variables
-   !USE dom_oce        ! ocean domain
-   !USE depth_e3       ! depth <=> e3
    USE usrdef_nam     ! User defined : namelist variables
    !
@@ -21,14 +23,13 @@
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! distributed memory computing library
-   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+   PUBLIC   usr_def_zgr        ! called by domzgr.F90
 
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: usrdef_zgr.F90 10072 2018-08-28 15:21:50Z nicolasmartin $
+   !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -47,12 +48,12 @@
       !!
       !!----------------------------------------------------------------------
-      LOGICAL                   , INTENT(  out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags ( read in namusr_def )
-      LOGICAL                   , INTENT(  out) ::   ld_isfcav                   ! under iceshelf cavity flag
-      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
-      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth        [m]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
-      INTEGER , DIMENSION(:,:)  , INTENT(  out) ::   k_top, k_bot                ! first & last ocean level
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
       !!----------------------------------------------------------------------
       !
@@ -61,10 +62,13 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       !
-
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
       ld_zco    = .TRUE.         ! z-coordinate without ocean cavities
       ld_zps    = .FALSE.
       ld_sco    = .FALSE.
       ld_isfcav = .FALSE.
-      
+
+      !! 1st level (the only one that matters)
       pdept_1d(1) = rn_dept1 ! depth (m) at which the SST is taken/measured == depth of first T point!
       pdepw_1d(1) = 0._wp
@@ -72,16 +76,33 @@
       pe3w_1d(1)  = rn_dept1 ! LB???
 
-      pdept(:,:,:) = rn_dept1
-      pdepw(:,:,:) = 0._wp
-      pe3t(:,:,:) = 2._wp*rn_dept1
-      pe3u(:,:,:) = 2._wp*rn_dept1
-      pe3v(:,:,:) = 2._wp*rn_dept1
-      pe3f(:,:,:) = 2._wp*rn_dept1
-      pe3w(:,:,:)  = rn_dept1  ! LB???
-      pe3uw(:,:,:) = rn_dept1  ! LB???
-      pe3vw(:,:,:) = rn_dept1  ! LB???
+      pdept(:,:,1) = rn_dept1
+      pdepw(:,:,1) = 0._wp
+      pe3t(:,:,1) = 2._wp*rn_dept1
+      pe3u(:,:,1) = 2._wp*rn_dept1
+      pe3v(:,:,1) = 2._wp*rn_dept1
+      pe3f(:,:,1) = 2._wp*rn_dept1
+      pe3w(:,:,1)  = rn_dept1  ! LB???
+      pe3uw(:,:,1) = rn_dept1  ! LB???
+      pe3vw(:,:,1) = rn_dept1  ! LB???
+      
+      !! 2nd level, technically useless (only for the sake of code stability)
+      pdept_1d(2) = 3._wp*rn_dept1
+      pdepw_1d(2) = 2._wp*rn_dept1
+      pe3t_1d(2)  = 2._wp*rn_dept1
+      pe3w_1d(2)  = 2._wp*rn_dept1
+
+      pdept(:,:,2) = 3._wp*rn_dept1
+      pdepw(:,:,2) = 2._wp*rn_dept1
+      pe3t(:,:,2) = 2._wp*rn_dept1
+      pe3u(:,:,2) = 2._wp*rn_dept1
+      pe3v(:,:,2) = 2._wp*rn_dept1
+      pe3f(:,:,2) = 2._wp*rn_dept1
+      pe3w(:,:,2)  = 2._wp*rn_dept1
+      pe3uw(:,:,2) = 2._wp*rn_dept1
+      pe3vw(:,:,2) = 2._wp*rn_dept1
+
       k_top = 1
       k_bot = 1
-      !
+
    END SUBROUTINE usr_def_zgr
    !!======================================================================
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/domvvl.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/domvvl.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/domvvl.F90	(revision 13197)
@@ -63,4 +63,6 @@
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -188,22 +190,18 @@
       gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb)
       gdepw(:,:,1,Kbb) = 0.0_wp
-      DO jk = 2, jpk                               ! vertical sum
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-               !                             ! 0.5 where jk = mikt     
+      DO_3D_11_11( 2, jpk )
+         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+         !                             ! 0.5 where jk = mikt     
 !!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ??
-               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
-               gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
-               gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
-                  &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
-               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
-               gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb)
-               gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  &
-                  &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
-            END DO
-         END DO
-      END DO
+         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb)
+         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
+      END_3D
       !
       !                    !==  thickness of the water column  !!   (ocean portion only)
@@ -240,27 +238,25 @@
          ENDIF
          IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO_2D_11_11
 !!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
-                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
-                     ! values outside the equatorial band and transition zone (ztilde)
-                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
-                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
-                     ! values inside the equatorial band (ztilde as zstar)
-                     frq_rst_e3t(ji,jj) =  0.0_wp
-                     frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt
-                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
-                     !                                      ! (linearly transition from z-tilde to z-star)
-                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
-                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                     frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                &
-                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   &
-                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                  ENDIF
-               END DO
-            END DO
+               IF( ABS(gphit(ji,jj)) >= 6.) THEN
+                  ! values outside the equatorial band and transition zone (ztilde)
+                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
+                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
+               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
+                  ! values inside the equatorial band (ztilde as zstar)
+                  frq_rst_e3t(ji,jj) =  0.0_wp
+                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt
+               ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                  !                                      ! (linearly transition from z-tilde to z-star)
+                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
+                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                &
+                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   &
+                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+               ENDIF
+            END_2D
             IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
                IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
@@ -357,6 +353,6 @@
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
-         !                                                            ! ------baroclinic part------ !
+      IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
+         !                                                               ! ------baroclinic part------ !
          ! I - initialization
          ! ==================
@@ -411,31 +407,21 @@
          zwu(:,:) = 0._wp
          zwv(:,:) = 0._wp
-         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
-                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
-                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
-            DO ji = 1, jpi
-               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
-               vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
-            END DO
-         END DO
-         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! vector opt.
-                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
-                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
+            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
+         END_3D
+         DO_2D_11_11
+            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
+            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
+         END_2D
+         DO_3D_00_00( 1, jpkm1 )
+            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
+               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
+               &                                            ) * r1_e1e2t(ji,jj)
+         END_3D
          !                       ! d - thickness diffusion transport: boundary conditions
          !                             (stored for tracer advction and continuity equation)
@@ -444,6 +430,4 @@
          ! 4 - Time stepping of baroclinic scale factors
          ! ---------------------------------------------
-         ! Leapfrog time stepping
-         ! ~~~~~~~~~~~~~~~~~~~~~~
          CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp )
          tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
@@ -646,5 +630,5 @@
       ! Horizontal scale factor interpolations
       ! --------------------------------------
-      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt
+      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt
       ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also
       
@@ -663,17 +647,13 @@
       gdepw(:,:,1,Kmm) = 0.0_wp
       gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
-      DO jk = 2, jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-                                                                 ! 1 for jk = mikt
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
-               gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  &
-                   &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
-               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 2, jpk )
+        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                           ! 1 for jk = mikt
+         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  &
+             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+      END_3D
 
       ! Local depth and Inverse of the local depth of the water
@@ -722,40 +702,28 @@
          !
       CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
-                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
          !
       CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
-                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
          !
       CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
-                     &                       *    r1_e1e2f(ji,jj)                                                  &
-                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+               &                       *    r1_e1e2f(ji,jj)                                                  &
+               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
@@ -832,7 +800,9 @@
             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
+            !
             !                             ! --------- !
             !                             ! all cases !
             !                             ! --------- !
+            !
             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
@@ -850,5 +820,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)
@@ -857,5 +827,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )
                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
@@ -864,5 +834,5 @@
                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'
                IF(lwp) write(numout,*) 'Compute scale factor from sshn'
-               IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                DO jk = 1, jpk
                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
@@ -917,12 +887,10 @@
                   ssh(:,:,Kbb) = -ssh_ref
 
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
-                           ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )
-                           ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )
-                        ENDIF
-                     ENDDO
-                  ENDDO
+                  DO_2D_11_11
+                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
+                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )
+                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )
+                     ENDIF
+                  END_2D
                ENDIF !If test case else
 
@@ -935,11 +903,9 @@
                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
 
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
-                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
-                     ENDIF
-                  END DO 
-               END DO 
+               DO_2D_11_11
+                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
+                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
+                  ENDIF
+               END_2D
                !
             ELSE
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -88,20 +90,18 @@
 #endif
          
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
-            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
-
-            plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
-            plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
-            plamv(ji,jj) = plamt(ji,jj) 
-            plamf(ji,jj) = plamu(ji,jj) 
-   
-            pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
-            pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
-            pphiu(ji,jj) = pphit(ji,jj) 
-            pphif(ji,jj) = pphiv(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 )
+         zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp
+         
+         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
+         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui
+         plamv(ji,jj) = plamt(ji,jj) 
+         plamf(ji,jj) = plamu(ji,jj) 
+         
+         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj
+         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj
+         pphiu(ji,jj) = pphit(ji,jj) 
+         pphif(ji,jj) = pphiv(ji,jj) 
+      END_2D
       !     
       ! Horizontal scale factors (in meters)
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_istate.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_istate.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_istate.F90	(revision 13197)
@@ -28,4 +28,6 @@
    PUBLIC   usr_def_istate   ! called by istate.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -73,29 +75,25 @@
       ! Sea level:
       za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH)))
-      DO ji=1, jpi
-         DO jj=1, jpj
-            zx = glamt(ji,jj) * 1.e3
-            zy = gphit(ji,jj) * 1.e3
-            zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2)
-            pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_11_11
+         zx = glamt(ji,jj) * 1.e3
+         zy = gphit(ji,jj) * 1.e3
+         zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2)
+         pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1)
+      END_2D
       !
       ! temperature:         
-      DO ji=1, jpi
-         DO jj=1, jpj
-            zx = glamt(ji,jj) * 1.e3
-            zy = gphit(ji,jj) * 1.e3
-            DO jk=1,jpk
-               zdt =  pdept(ji,jj,jk) 
-               zrho1 = rho0 * (1._wp + zn2*zdt/grav)
-               IF (zdt < zH) THEN
-                  zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) &
-                          & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + exp(-zH)));
-               ENDIF
-               pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
-            END DO
+      DO_2D_11_11
+         zx = glamt(ji,jj) * 1.e3
+         zy = gphit(ji,jj) * 1.e3
+         DO jk=1,jpk
+            zdt =  pdept(ji,jj,jk) 
+            zrho1 = rho0 * (1._wp + zn2*zdt/grav)
+            IF (zdt < zH) THEN
+               zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) &
+                  & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + EXP(-zH)));
+            ENDIF
+            pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
          END DO
-      END DO
+      END_2D
       !
       ! salinity:  
@@ -104,38 +102,33 @@
       ! velocities:
       za = 2._wp * zP0 / (zf0 * rho0 * zlambda**2)
-      DO ji=1, jpim1
-         DO jj=1, jpj
-            zx = glamu(ji,jj) * 1.e3
-            zy = gphiu(ji,jj) * 1.e3
-            DO jk=1, jpk
-               zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk))
-               IF (zdu < zH) THEN
-                  zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH))
-                  pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk)
-               ELSE
-                  pu(ji,jj,jk) = 0._wp
-               ENDIF
-            END DO
+      DO_2D_00_00
+         zx = glamu(ji,jj) * 1.e3
+         zy = gphiu(ji,jj) * 1.e3
+         DO jk=1, jpk
+            zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk))
+            IF (zdu < zH) THEN
+               zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH))
+               pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk)
+            ELSE
+               pu(ji,jj,jk) = 0._wp
+            ENDIF
          END DO
-      END DO
+      END_2D
       !
-      DO ji=1, jpi
-         DO jj=1, jpjm1
-            zx = glamv(ji,jj) * 1.e3
-            zy = gphiv(ji,jj) * 1.e3
-            DO jk=1, jpk
-               zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk))
-               IF (zdv < zH) THEN
-                  zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH))
-                  pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk)
-               ELSE
-                  pv(ji,jj,jk) = 0._wp
-               ENDIF
-            END DO
+      DO_2D_00_00
+         zx = glamv(ji,jj) * 1.e3
+         zy = gphiv(ji,jj) * 1.e3
+         DO jk=1, jpk
+            zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk))
+            IF (zdv < zH) THEN
+               zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH))
+               pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk)
+            ELSE
+               pv(ji,jj,jk) = 0._wp
+            ENDIF
          END DO
-      END DO
-
-      CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. )
-      CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. )
+      END_2D
+      !
+      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
       !   
    END SUBROUTINE usr_def_istate
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/VORTEX/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -192,5 +192,5 @@
       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
       !
-      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere
+      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere
       !
       k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_hgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_hgr.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called by domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -72,17 +74,16 @@
       !                       !==  grid point position  ==!   (in kilometers)
       zfact = rn_dx * 1.e-3         ! conversion in km
-      DO jj = 1, jpj
-         DO ji = 1, jpi             ! longitude
-            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
-            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
-            plamv(ji,jj) = plamt(ji,jj)
-            plamf(ji,jj) = plamu(ji,jj)
-            !                       ! latitude
-            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
-            pphiu(ji,jj) = pphit(ji,jj)
-            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
-            pphif(ji,jj) = pphiv(ji,jj)
-         END DO
-      END DO
+      DO_2D_11_11
+         !                       ! longitude
+         plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+         plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+         plamv(ji,jj) = plamt(ji,jj)
+         plamf(ji,jj) = plamu(ji,jj)
+         !                       ! latitude
+         pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+         pphiu(ji,jj) = pphit(ji,jj)
+         pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+         pphif(ji,jj) = pphiv(ji,jj)
+      END_2D
       !
       !                       !==  Horizontal scale factors  ==!   (in meters) 
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_istate.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_istate.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_istate.F90	(revision 13197)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_istate   ! called in istate.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -174,11 +176,9 @@
       ! Apply minimum wetdepth criterion
       !
-      do jj = 1,jpj
-         do ji = 1,jpi
-            IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN
-               pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) )
-            ENDIF
-         end do
-      end do
+      DO_2D_11_11
+         IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN
+            pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) )
+         ENDIF
+      END_2D
       !
    END SUBROUTINE usr_def_istate
Index: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_zgr.F90	(revision 13159)
+++ NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/WAD/MY_SRC/usrdef_zgr.F90	(revision 13197)
@@ -29,4 +29,6 @@
    PUBLIC   usr_def_zgr        ! called by domzgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -242,7 +244,7 @@
       ! at v-point: averaging zht
       zhv = 0._wp
-      DO jj = 1, jpjm1
-         zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) )
-      END DO
+      DO_2D_00_00
+         zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) )
+      END_2D
       CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. )     ! boundary condition: this mask the surrounding grid-points
       DO jj = mj0(1), mj1(1)   ! first  row of global domain only
@@ -279,34 +281,30 @@
          ht_0 = zht
          k_bot(:,:) = jpkm1 * k_top(:,:)  !* bottom ocean = jpk-1 (here use k_top as a land mask)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-              IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN
-                k_bot(ji,jj) = 0
-                k_top(ji,jj) = 0
-              ENDIF
-           END DO
-         END DO
+         DO_2D_11_11
+            IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN
+               k_bot(ji,jj) = 0
+               k_top(ji,jj) = 0
+            ENDIF
+         END_2D
          !
          !                                !* terrain-following coordinate with e3.(k)=cst)
          !                                !  OVERFLOW case : identical with j-index (T=V, U=F)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-              z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp)
-              DO jk = 1, jpk
-                  zwet = MAX( zht(ji,jj), rn_wdmin1 )
-                  pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp )
-                  pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp )          )
-                  pe3t (ji,jj,jk) = zwet * z1_jpkm1
-                  pe3w (ji,jj,jk) = zwet * z1_jpkm1
-                  zwet = MAX( zhu(ji,jj), rn_wdmin1 )
-                  pe3u (ji,jj,jk) = zwet * z1_jpkm1
-                  pe3uw(ji,jj,jk) = zwet * z1_jpkm1
-                  pe3f (ji,jj,jk) = zwet * z1_jpkm1
-                  zwet = MAX( zhv(ji,jj), rn_wdmin1 )
-                  pe3v (ji,jj,jk) = zwet * z1_jpkm1
-                  pe3vw(ji,jj,jk) = zwet * z1_jpkm1
-              END DO      
-           END DO      
-         END DO      
+         DO_2D_00_00
+            z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp)
+            DO jk = 1, jpk
+               zwet = MAX( zht(ji,jj), rn_wdmin1 )
+               pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp )
+               pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp )          )
+               pe3t (ji,jj,jk) = zwet * z1_jpkm1
+               pe3w (ji,jj,jk) = zwet * z1_jpkm1
+               zwet = MAX( zhu(ji,jj), rn_wdmin1 )
+               pe3u (ji,jj,jk) = zwet * z1_jpkm1
+               pe3uw(ji,jj,jk) = zwet * z1_jpkm1
+               pe3f (ji,jj,jk) = zwet * z1_jpkm1
+               zwet = MAX( zhv(ji,jj), rn_wdmin1 )
+               pe3v (ji,jj,jk) = zwet * z1_jpkm1
+               pe3vw(ji,jj,jk) = zwet * z1_jpkm1
+            END DO
+         END_2D     
          CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. )
          CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. )
