Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90	(revision 13469)
@@ -122,55 +122,53 @@
       !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               !---------------------------------------------!
-               !--- Specific snow, ice and pond fractions ---!
-               !---------------------------------------------!               
-               zafrac_snw = za_s_fra(ji,jj,jl)
-               IF( ld_pnd_alb ) THEN
-                  zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1
-               ELSE
-                  zafrac_pnd = 0._wp
-               ENDIF
-               zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors
-               !
-               !---------------!
-               !--- Albedos ---!
-               !---------------!               
-               !                       !--- Bare ice albedo (for hi > 150cm)
-               IF( ld_pnd_alb ) THEN
-                  zalb_ice = rn_alb_idry
-               ELSE
-                  IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt
-                  ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF
-               ENDIF
-               !                       !--- Bare ice albedo (for hi < 150cm)
-               IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm
-                  zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) )
-               ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm
-                  zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl)
-               ENDIF
-               !
-               !                       !--- Snow-covered ice albedo (freezing, melting cases)
-               IF( pt_su(ji,jj,jl) < rt0 ) THEN
-                  zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 )
-               ELSE
-                  zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 )
-               ENDIF
-               !                       !--- Ponded ice albedo
-               zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 
-               !
-               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
-               zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1)
-               !
-               zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  &
-                  &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1)
-               !
-               ! albedo depends on cloud fraction because of non-linear spectral effects
-               palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os
-
-            END DO
-         END DO
+         DO_2D_11_11
+            !
+            !---------------------------------------------!
+            !--- Specific snow, ice and pond fractions ---!
+            !---------------------------------------------!               
+            zafrac_snw = za_s_fra(ji,jj,jl)
+            IF( ld_pnd_alb ) THEN
+               zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1
+            ELSE
+               zafrac_pnd = 0._wp
+            ENDIF
+            zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors
+            !
+            !---------------!
+            !--- Albedos ---!
+            !---------------!               
+            !                       !--- Bare ice albedo (for hi > 150cm)
+            IF( ld_pnd_alb ) THEN
+               zalb_ice = rn_alb_idry
+            ELSE
+               IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt
+               ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF
+            ENDIF
+            !                       !--- Bare ice albedo (for hi < 150cm)
+            IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm
+               zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) )
+            ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm
+               zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl)
+            ENDIF
+            !
+            !                       !--- Snow-covered ice albedo (freezing, melting cases)
+            IF( pt_su(ji,jj,jl) < rt0 ) THEN
+               zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 )
+            ELSE
+               zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 )
+            ENDIF
+            !                       !--- Ponded ice albedo
+            zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 
+            !
+            !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
+            zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1)
+            !
+            zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  &
+               &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1)
+            !
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os
+
+         END_2D
       END DO
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90	(revision 13469)
@@ -92,11 +92,9 @@
          zzc = rhoi * r1_rdtice
          DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  zsal = sv_i(ji,jj,jl)
-                  sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
-               END DO
-            END DO
+            DO_2D_11_11
+               zsal = sv_i(ji,jj,jl)
+               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
+               sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
+            END_2D
          END DO
       ENDIF
@@ -107,14 +105,12 @@
       !                             !-----------------------------------------------------
       IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
-         DO jj = 2, jpjm1           !-----------------------------------------------------
-            DO ji = 2, jpim1
-               IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
-                  IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
-                  IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
-                  IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
-                  IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
+               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
+               IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
+               IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
+               IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
+            ENDIF
+         END_2D
          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )
       ENDIF
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90	(revision 13469)
@@ -366,15 +366,13 @@
       cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( v_i(ji,jj,jl) > epsi10  ) THEN
-                  IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN
-                     WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl)
-                     WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
-                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
+         DO_2D_11_11
+            IF( v_i(ji,jj,jl) > epsi10  ) THEN
+               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN
+                  WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl)
+                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
                ENDIF
-            END DO
-         END DO
+            ENDIF
+         END_2D
       END DO
 
@@ -383,15 +381,13 @@
       cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( v_i(ji,jj,jl) > epsi10  ) THEN
-                  IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN
-                     WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl)
-                     WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
-                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
+         DO_2D_11_11
+            IF( v_i(ji,jj,jl) > epsi10  ) THEN
+               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN
+                  WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl)
+                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
                ENDIF
-            END DO
-         END DO
+            ENDIF
+         END_2D
       END DO
 
@@ -400,16 +396,12 @@
       cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
-                  IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN
-                     WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0)
-                     WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl
-                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
+            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN
+               WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0)
+               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl
+              inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_3D
       END DO
   
@@ -418,16 +410,12 @@
       cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
-                  IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN
-                     WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0)
-                     WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl
-                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
+            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN
+               WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0)
+               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl
+              inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_3D
       END DO
       
@@ -436,13 +424,11 @@
       cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert
       jl = jpl 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( h_i(ji,jj,jl) > 50._wp ) THEN
-               WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl)
-               WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( h_i(ji,jj,jl) > 50._wp ) THEN
+            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl)
+            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alerte if very thin ice
@@ -450,53 +436,45 @@
       cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert
       jl = 1 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( h_i(ji,jj,jl) < rn_himin ) THEN
-               WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl)
-               WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( h_i(ji,jj,jl) < rn_himin ) THEN
+            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl)
+            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert if very fast ice
       ialert_id = ialert_id + 1 ! reference number of this alert
       cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN
-               WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) )
-               WRITE(numout,*) ' at i,j = ',ji,jj
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN
+            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) )
+            WRITE(numout,*) ' at i,j = ',ji,jj
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert if there is ice on continents
       ialert_id = ialert_id + 1 ! reference number of this alert
       cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 
-               WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj)
-               WRITE(numout,*) ' at i,j = ',ji,jj
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 
+            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj)
+            WRITE(numout,*) ' at i,j = ',ji,jj
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert if incompatible ice concentration and volume
       ialert_id = ialert_id + 1 ! reference number of this alert
       cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. &
-               & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 
-               WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj)
-               WRITE(numout,*) ' at i,j = ',ji,jj
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. &
+            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 
+            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj)
+            WRITE(numout,*) ' at i,j = ',ji,jj
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! sum of the alerts on all processors
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90	(revision 13469)
@@ -127,12 +127,10 @@
          ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length
          ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. )
-               zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. )
-               u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)
-               v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_11_11
+            zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. )
+            zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. )
+            u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)
+            v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)
+         END_2D
          ! ---
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
@@ -158,10 +156,8 @@
 
             ALLOCATE( zdivu_i(jpi,jpj) )
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-                     &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj)
+            END_2D
             CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. )
             ! output
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90	(revision 13469)
@@ -110,24 +110,22 @@
       END WHERE
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
-                  &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
-               zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
-                  &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
-               zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
-                  &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
-               zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), &
-                  &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), &
-                  &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), &
-                  &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
+               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
+            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
+               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
+               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
+               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
+            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
+               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
+               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
+               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
+            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), &
+               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), &
+               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), &
+               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) )
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. )
@@ -145,26 +143,18 @@
       END DO
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), &
-                     &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), &
-                     &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), &
-                     &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, nlay_i )
+            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), &
+               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), &
+               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), &
+               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) )
+         END_3D
       END DO
       DO jl = 1, jpl
-         DO jk = 1, nlay_s
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), &
-                     &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), &
-                     &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), &
-                     &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, nlay_s )
+            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), &
+               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), &
+               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), &
+               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) )
+         END_3D
       END DO
       CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. )
@@ -317,10 +307,8 @@
          ! derive open water from ice concentration
          zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water
-                  &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
-            END DO
-         END DO
+         DO_2D_00_00
+            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water
+               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
+         END_2D
          CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1. )
          !
@@ -375,132 +363,120 @@
          !
          ! Limitation of moments.                                           
-         DO jj = 2, jpjm1
-            DO ji = 1, jpi
-               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-               psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 )
-               !
-               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
-               zs1max  = 1.5 * zslpmax
-               zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) )
-               zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
-                  &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  )
-               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-
-               ps0 (ji,jj,jl) = zslpmax  
-               psx (ji,jj,jl) = zs1new         * rswitch
-               psxx(ji,jj,jl) = zs2new         * rswitch
-               psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch
-               psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch
-               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
-            END DO
-         END DO
+         DO_2D_00_11
+            !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+            psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 )
+            !
+            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+
+            ps0 (ji,jj,jl) = zslpmax  
+            psx (ji,jj,jl) = zs1new         * rswitch
+            psxx(ji,jj,jl) = zs2new         * rswitch
+            psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch
+            psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch
+            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
+         END_2D
 
          !  Calculate fluxes and moments between boxes i<-->i+1              
-         DO jj = 2, jpjm1                      !  Flux from i to i+1 WHEN u GT 0 
-            DO ji = 1, jpi
-               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
-               zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl)
-               zalfq        =  zalf * zalf
-               zalf1        =  1.0 - zalf
-               zalf1q       =  zalf1 * zalf1
-               !
-               zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl)
-               zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) )
-               zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) )
-               zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq
-               zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
-               zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl)
-               zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl)
-
-               !  Readjust moments remaining in the box.
-               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
-               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
-               psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) )
-               psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl)
-               psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj)
-               psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj)
-               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0.
-            DO ji = 1, fs_jpim1
-               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 
-               zalg  (ji,jj) = zalf
-               zalfq         = zalf * zalf
-               zalf1         = 1.0 - zalf
-               zalg1 (ji,jj) = zalf1
-               zalf1q        = zalf1 * zalf1
-               zalg1q(ji,jj) = zalf1q
-               !
-               zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl)
-               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) &
-                  &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) )
-               zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) )
-               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq
-               zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) )
-               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl)
-               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji-1,jj)
-               zbt1 = 1.0 - zbet(ji-1,jj)
-               !
-               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) )
-               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) )
-               psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) )
-               psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl)
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) )
-               psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_00_11
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
+            zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl)
+            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) )
+            zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) )
+            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq
+            zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
+            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl)
+            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl)
+
+            !  Readjust moments remaining in the box.
+            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
+            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
+            psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) )
+            psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl)
+            psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj)
+            psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj)
+            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_10
+            zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) &
+               &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            !
+            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) )
+            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) )
+            psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) )
+            psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl)
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) )
+            psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl)
+         END_2D
 
          !   Put the temporary moments into appropriate neighboring boxes.    
-         DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji-1,jj)
-               zbt1 = 1.0 - zbet(ji-1,jj)
-               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl)
-               zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj)
-               !
-               ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl)
-               psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl)
-               psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             &
-                  &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) &
-                  &            + zbt1 * psxx(ji,jj,jl)
-               psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             &
-                  &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   &
-                  &            + zbt1 * psxy(ji,jj,jl)
-               psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl)
-               psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from i+1 to i IF u LT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj)
-               zbt1 = 1.0 - zbet(ji,jj)
-               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
-               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
-               !
-               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) )
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) &
-                  &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    &
-                  &                                           + ( zalf1 - zalf ) * ztemp ) )
-               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
-                  &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) )
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl)
+            zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj)
+            !
+            ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl)
+            psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl)
+            psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             &
+               &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) &
+               &            + zbt1 * psxx(ji,jj,jl)
+            psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             &
+               &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   &
+               &            + zbt1 * psxy(ji,jj,jl)
+            psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl)
+            psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
+            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
+            !
+            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) )
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) &
+               &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    &
+               &                                           + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
+               &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) )
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) )
+         END_2D
 
       END DO
@@ -544,134 +520,122 @@
          !
          ! Limitation of moments.
-         DO jj = 1, jpj
-            DO ji = fs_2, fs_jpim1
-               !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-               psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  )
-               !
-               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
-               zs1max  = 1.5 * zslpmax
-               zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) )
-               zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
-                  &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  )
-               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-               !
-               ps0 (ji,jj,jl) = zslpmax  
-               psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch
-               psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch
-               psy (ji,jj,jl) = zs1new         * rswitch
-               psyy(ji,jj,jl) = zs2new         * rswitch
-               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
-            END DO
-         END DO
+         DO_2D_11_00
+            !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+            psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  )
+            !
+            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) )
+            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj,jl) = zslpmax  
+            psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch
+            psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch
+            psy (ji,jj,jl) = zs1new         * rswitch
+            psyy(ji,jj,jl) = zs2new         * rswitch
+            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
+         END_2D
  
          !  Calculate fluxes and moments between boxes j<-->j+1              
-         DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
-            DO ji = fs_2, fs_jpim1
-               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
-               zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl)
-               zalfq        =  zalf * zalf
-               zalf1        =  1.0 - zalf
-               zalf1q       =  zalf1 * zalf1
-               !
-               zfm (ji,jj)  =  zalf  * psm(ji,jj,jl)
-               zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 
-               zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) )
-               zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl)
-               zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
-               zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl)
-               zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl)
-               !
-               !  Readjust moments remaining in the box.
-               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
-               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
-               psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) )
-               psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl)
-               psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj)
-               psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj)
-               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
-            END DO
-         END DO
-         !
-         DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
-            DO ji = fs_2, fs_jpim1
-               zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 
-               zalg  (ji,jj) = zalf
-               zalfq         = zalf * zalf
-               zalf1         = 1.0 - zalf
-               zalg1 (ji,jj) = zalf1
-               zalf1q        = zalf1 * zalf1
-               zalg1q(ji,jj) = zalf1q
-               !
-               zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji,jj+1,jl)
-               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) &
-                  &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) )
-               zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) )
-               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq
-               zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) )
-               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl)
-               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl)
-            END DO
-         END DO
+         DO_2D_11_00
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
+            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  * psm(ji,jj,jl)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 
+            zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) )
+            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl)
+            zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl)
+            zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
+            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
+            psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) )
+            psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl)
+            psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj)
+            psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj)
+            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
+         END_2D
+         !
+         DO_2D_10_00
+            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji,jj+1,jl)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) &
+               &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) )
+            zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) )
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq
+            zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl)
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl)
+         END_2D
 
          !  Readjust moments remaining in the box. 
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zbt  =         zbet(ji,jj-1)
-               zbt1 = ( 1.0 - zbet(ji,jj-1) )
-               !
-               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) )
-               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) )
-               psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) )
-               psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl)
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) )
-               psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            !
+            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) )
+            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) )
+            psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) )
+            psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl)
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) )
+            psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl)
+         END_2D
 
          !   Put the temporary moments into appropriate neighboring boxes.    
-         DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj-1)
-               zbt1 = 1.0 - zbet(ji,jj-1)
-               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 
-               zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 
-               zalf1         = 1.0 - zalf
-               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1)
-               !
-               ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl)
-               psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  &
-                  &             + zbt1 * psy(ji,jj,jl)  
-               psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           &
-                  &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 
-                  &             + zbt1 * psyy(ji,jj,jl)
-               psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            &
-                  &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  &
-                  &             + zbt1 * psxy(ji,jj,jl)
-               psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl)
-               psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from j+1 to j IF v LT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj)
-               zbt1 = 1.0 - zbet(ji,jj)
-               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
-               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
-               !
-               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) )
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) &
-                  &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    &
-                  &                                            + ( zalf1 - zalf ) * ztemp ) )
-               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
-                  &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) )
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj-1)
+            zbt1 = 1.0 - zbet(ji,jj-1)
+            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 
+            zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 
+            zalf1         = 1.0 - zalf
+            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1)
+            !
+            ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl)
+            psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  &
+               &             + zbt1 * psy(ji,jj,jl)  
+            psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           &
+               &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 
+               &             + zbt1 * psyy(ji,jj,jl)
+            psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            &
+               &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  &
+               &             + zbt1 * psxy(ji,jj,jl)
+            psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl)
+            psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
+            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
+            !
+            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) )
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) &
+               &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    &
+               &                                            + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
+               &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) )
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) )
+         END_2D
 
       END DO
@@ -715,86 +679,76 @@
       !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               !                               ! -- check h_ip -- !
+               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
+               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
+                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
+                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
+                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
+                  ENDIF
+               ENDIF
+               !
+               !                               ! -- check h_i -- !
+               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
+               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
+               ENDIF
+               !
+               !                               ! -- check h_s -- !
+               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
+               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
                   !
-                  !                               ! -- check h_ip -- !
-                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
-                  IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
-                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
-                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
-                        pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
-                     ENDIF
-                  ENDIF
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
                   !
-                  !                               ! -- check h_i -- !
-                  ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
-                  zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
-                  ENDIF
-                  !
-                  !                               ! -- check h_s -- !
-                  ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
-                  zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
-                     !
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     !
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
-                  ENDIF           
-                  !                  
-                  !                               ! -- check s_i -- !
-                  ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
-                  zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
-                  IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     zfra = psi_max(ji,jj,jl) / zsi
-                     sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
-                     psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
-                  ENDIF
-                  !
-               ENDIF
-            END DO
-         END DO
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
+               ENDIF           
+               !                  
+               !                               ! -- check s_i -- !
+               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
+               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
+               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = psi_max(ji,jj,jl) / zsi
+                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
+                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
+               ENDIF
+               !
+            ENDIF
+         END_2D
       END DO 
       !
       !                                           ! -- check e_i/v_i -- !
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
-                     ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean
-                     zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl)
-                     IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                        zfra = pei_max(ji,jj,jk,jl) / zei
-                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                        pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean
+               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl)
+               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = pei_max(ji,jj,jk,jl) / zei
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra
+               ENDIF
+            ENDIF
+         END_3D
       END DO
       !                                           ! -- check e_s/v_s -- !
       DO jl = 1, jpl
-         DO jk = 1, nlay_s
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( pv_s(ji,jj,jl) > 0._wp ) THEN
-                     ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean
-                     zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl)
-                     IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                        zfra = pes_max(ji,jj,jk,jl) / zes
-                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                        pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_s )
+            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN
+               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean
+               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl)
+               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = pes_max(ji,jj,jk,jl) / zes
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra
+               ENDIF
+            ENDIF
+         END_3D
       END DO
       !
@@ -829,23 +783,21 @@
       ! -- check snow load -- !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
-                  !
-                  zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
-                  !
-                  IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
-                     ! put snow excess in the ocean
-                     zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     ! correct snow volume and heat content
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
-                  ENDIF
-                  !
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
+               !
+               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
+                  ! put snow excess in the ocean
+                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  ! correct snow volume and heat content
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
+               ENDIF
+               !
+            ENDIF
+         END_2D
       END DO
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90	(revision 13469)
@@ -114,24 +114,22 @@
       END WHERE
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
-                  &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
-               zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
-                  &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
-               zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
-                  &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
-               zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), &
-                  &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), &
-                  &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), &
-                  &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
+               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
+            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
+               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
+               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
+               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
+            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
+               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
+               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
+               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
+            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), &
+               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), &
+               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), &
+               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) )
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. )
@@ -149,26 +147,18 @@
       END DO
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), &
-                     &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), &
-                     &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), &
-                     &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) )
-               END DO
-            END DO
-         END DO
-      END DO
-      DO jl = 1, jpl
-         DO jk = 1, nlay_s
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), &
-                     &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), &
-                     &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), &
-                     &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, nlay_i )
+            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), &
+               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), &
+               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), &
+               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) )
+         END_3D
+      END DO
+      DO jl = 1, jpl
+         DO_3D_00_00( 1, nlay_s )
+            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), &
+               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), &
+               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), &
+               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) )
+         END_3D
       END DO
       CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. )
@@ -201,17 +191,15 @@
       !
       ! --- define velocity for advection: u*grad(H) --- !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
-            ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj)
-            ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj)
-            ENDIF
-
-            IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
-            ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1)
-            ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  )
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
+         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj)
+         ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj)
+         ENDIF
+
+         IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
+         ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1)
+         ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  )
+         ENDIF
+      END_2D
 
       !---------------!
@@ -236,14 +224,12 @@
             IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
             DO jl = 1, jpl
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) )
-                     IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0
-                     ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF
-                     zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) )
-                     IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0
-                     ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF
-                  END DO
-               END DO
+               DO_2D_10_10
+                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) )
+                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0
+                  ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF
+                  zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) )
+                  IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0
+                  ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF
+               END_2D
             END DO
          ENDIF
@@ -394,10 +380,8 @@
          !== Open water area ==!
          zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
-                  &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
-            END DO
-         END DO
+         DO_2D_00_00
+            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
+               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
+         END_2D
          CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. )
          !
@@ -506,23 +490,21 @@
       IF( pamsk == 0._wp ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( ABS( pu(ji,jj) ) > epsi10 ) THEN
-                     zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj)
-                     zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj)
-                  ELSE
-                     zfu_ho (ji,jj,jl) = 0._wp
-                     zfu_ups(ji,jj,jl) = 0._wp
-                  ENDIF
-                  !
-                  IF( ABS( pv(ji,jj) ) > epsi10 ) THEN
-                     zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj)
-                     zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
-                  ELSE
-                     zfv_ho (ji,jj,jl) = 0._wp  
-                     zfv_ups(ji,jj,jl) = 0._wp  
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( ABS( pu(ji,jj) ) > epsi10 ) THEN
+                  zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj)
+                  zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj)
+               ELSE
+                  zfu_ho (ji,jj,jl) = 0._wp
+                  zfu_ups(ji,jj,jl) = 0._wp
+               ENDIF
+               !
+               IF( ABS( pv(ji,jj) ) > epsi10 ) THEN
+                  zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj)
+                  zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
+               ELSE
+                  zfv_ho (ji,jj,jl) = 0._wp  
+                  zfv_ups(ji,jj,jl) = 0._wp  
+               ENDIF
+            END_2D
          END DO
 
@@ -530,11 +512,9 @@
          ! thus we calculate the upstream solution and apply a limiter again
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) )
-                  !
-                  zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) )
+               !
+               zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1. )
@@ -553,10 +533,8 @@
       IF( PRESENT( pua_ho ) ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)
-                  pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)
-              END DO
-            END DO
+            DO_2D_10_10
+               pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)
+               pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)
+            END_2D
          END DO
       ENDIF
@@ -565,11 +543,9 @@
       ! ---------------------------------
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )  
-               !
-               ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)               
-            END DO
-         END DO
+         DO_2D_00_00
+            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )  
+            !
+            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)               
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. )
@@ -601,72 +577,58 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
+            DO_2D_10_10
+               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
+               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
+            END_2D
+         END DO
+         !
+      ELSE                              !** alternate directions **!
+         !
+         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==!
+            !
+            DO jl = 1, jpl              !-- flux in x-direction
+               DO_2D_10_10
                   pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
+               END_2D
+            END DO
+            !
+            DO jl = 1, jpl              !-- first guess of tracer from u-flux
+               DO_2D_00_00
+                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              &
+                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
+            END DO
+            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
+            !
+            DO jl = 1, jpl              !-- flux in y-direction
+               DO_2D_10_10
+                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl)
+               END_2D
+            END DO
+            !
+         ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==!
+            !
+            DO jl = 1, jpl              !-- flux in y-direction
+               DO_2D_10_10
                   pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
-               END DO
-            END DO
-         END DO
-         !
-      ELSE                              !** alternate directions **!
-         !
-         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==!
+               END_2D
+            END DO
+            !
+            DO jl = 1, jpl              !-- first guess of tracer from v-flux
+               DO_2D_00_00
+                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  &
+                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
+            END DO
+            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
-                  END DO
-               END DO
-            END DO
-            !
-            DO jl = 1, jpl              !-- first guess of tracer from u-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              &
-                        &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
-            !
-            DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl)
-                  END DO
-               END DO
-            END DO
-            !
-         ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==!
-            !
-            DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
-                  END DO
-               END DO
-            END DO
-            !
-            DO jl = 1, jpl              !-- first guess of tracer from v-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  &
-                        &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
-            !
-            DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl)
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl)
+               END_2D
             END DO
             !
@@ -676,14 +638,12 @@
       !
       DO jl = 1, jpl                    !-- after tracer with upstream scheme
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   &
-                  &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) &
-                  &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   &
-                  &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-               !
-               pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   &
+               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) &
+               &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   &
+               &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+            !
+            pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. )
@@ -717,10 +677,8 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) )
-                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) )
+               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) )
+            END_2D
          END DO
          !
@@ -737,30 +695,24 @@
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
 
             DO jl = 1, jpl              !-- first guess of tracer from u-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              &
-                        &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              &
+                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
             END DO
             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
 
             DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
@@ -769,30 +721,24 @@
             !
             DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
             !
             DO jl = 1, jpl              !-- first guess of tracer from v-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  &
-                        &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  &
+                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
             END DO
             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
@@ -840,12 +786,10 @@
          !                                                        !--  advective form update in zpt  --!
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) &
-                     &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) &
-                     &                                                                                        * pamsk           &
-                     &                             ) * pdt ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) &
+                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) &
+                  &                                                                                        * pamsk           &
+                  &                             ) * pdt ) * tmask(ji,jj,1)
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
@@ -869,12 +813,10 @@
          !                                                        !--  advective form update in zpt  --!
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) &
-                     &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) &
-                     &                                                                                        * pamsk           &
-                     &                             ) * pdt ) * tmask(ji,jj,1) 
-               END DO
-            END DO
+            DO_2D_00_00
+               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) &
+                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) &
+                  &                                                                                        * pamsk           &
+                  &                             ) * pdt ) * tmask(ji,jj,1) 
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
@@ -953,10 +895,8 @@
          !        
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
@@ -964,11 +904,9 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                     &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
-               END DO
-            END DO
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
+            END_2D
          END DO
          !  
@@ -976,15 +914,13 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -992,15 +928,13 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -1008,18 +942,16 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  zdx4 = zdx2 * zdx2
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) &
-                     &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               zdx4 = zdx2 * zdx2
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) &
+                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -1031,21 +963,17 @@
       IF( ll_neg ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
-                     pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                        &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
+                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
+               ENDIF
+            END_2D
          END DO
       ENDIF
       !                                                     !-- High order flux in i-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl)
+         END_2D
       END DO
       !
@@ -1078,14 +1006,10 @@
       !                                                     !--  Laplacian in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1         ! First derivative (gradient)
-            DO ji = fs_2, fs_jpim1
-               ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-         DO jj = 2, jpjm1         ! Second derivative (Laplacian)
-            DO ji = fs_2, fs_jpim1
-               ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_00
+            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END_2D
+         DO_2D_00_00
+            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. )
@@ -1093,14 +1017,10 @@
       !                                                     !--  BiLaplacian in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1         ! First derivative
-            DO ji = fs_2, fs_jpim1
-               ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-         DO jj = 2, jpjm1         ! Second derivative
-            DO ji = fs_2, fs_jpim1
-               ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_00
+            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END_2D
+         DO_2D_00_00
+            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. )
@@ -1111,69 +1031,59 @@
       CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
-                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
+                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
       CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
-                     &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
+                  &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
       CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
       CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
       CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  zdy4 = zdy2 * zdy2
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) &
-                     &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               zdy4 = zdy2 * zdy2
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) &
+                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -1185,21 +1095,17 @@
       IF( ll_neg ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
-                     pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  &
-                        &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
+                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  &
+                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+               ENDIF
+            END_2D
          END DO
       ENDIF
       !                                                     !-- High order flux in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl)
+         END_2D
       END DO
       !
@@ -1235,10 +1141,8 @@
       ! --------------------------------------------------
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
-               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
+            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
+         END_2D
       END DO
 
@@ -1254,34 +1158,30 @@
          
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1 
-                  zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl)
-                  ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl)
-               END DO
-            END DO
+            DO_2D_00_00
+               zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl)
+               ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl)
+            END_2D
          END DO
          CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. )
 
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  &
-                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN
-                     !
-                     IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  &
-                        & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN
-                        pfu_ho(ji,jj,jl)=0._wp
-                        pfv_ho(ji,jj,jl)=0._wp
-                     ENDIF
-                     !
-                     IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  &
-                        & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN
-                        pfu_ho(ji,jj,jl)=0._wp
-                        pfv_ho(ji,jj,jl)=0._wp
-                     ENDIF
-                     !
+            DO_2D_00_00
+               IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  &
+                  & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN
+                  !
+                  IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  &
+                     & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN
+                     pfu_ho(ji,jj,jl)=0._wp
+                     pfv_ho(ji,jj,jl)=0._wp
                   ENDIF
-               END DO
-            END DO
+                  !
+                  IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  &
+                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN
+                     pfu_ho(ji,jj,jl)=0._wp
+                     pfv_ho(ji,jj,jl)=0._wp
+                  ENDIF
+                  !
+               ENDIF
+            END_2D
          END DO
          CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. )   ! lateral boundary cond.
@@ -1295,54 +1195,50 @@
       DO jl = 1, jpl
          
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
-                  zbup(ji,jj) = -zbig
-                  zbdo(ji,jj) =  zbig
-               ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN
-                  zbup(ji,jj) = pt_ups(ji,jj,jl)
-                  zbdo(ji,jj) = pt_ups(ji,jj,jl)
-               ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
-                  zbup(ji,jj) = pt(ji,jj,jl)
-                  zbdo(ji,jj) = pt(ji,jj,jl)
-               ELSE
-                  zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
-                  zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
-               ENDIF
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !
-               zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood
-               zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) )
-               !
-               zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux
-                  & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) )
-               zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) &
-                  & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) )
-               !
-               zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) &
-                  &          ) * ( 1. - pamsk )
-               zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) &
-                  &          ) * ( 1. - pamsk )
-               !
-               !                                  ! up & down beta terms
-               ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!)
-               IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt
-               ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig
-               ENDIF
-               !
-               IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt
-               ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig
-               ENDIF
-               !
-               ! if all the points are outside ice cover
-               IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig
-               IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig            
-               !
-            END DO
-         END DO
+         DO_2D_11_11
+            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
+               zbup(ji,jj) = -zbig
+               zbdo(ji,jj) =  zbig
+            ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN
+               zbup(ji,jj) = pt_ups(ji,jj,jl)
+               zbdo(ji,jj) = pt_ups(ji,jj,jl)
+            ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
+               zbup(ji,jj) = pt(ji,jj,jl)
+               zbdo(ji,jj) = pt(ji,jj,jl)
+            ELSE
+               zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
+               zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
+            ENDIF
+         END_2D
+
+         DO_2D_00_00
+            !
+            zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood
+            zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) )
+            !
+            zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux
+               & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) )
+            zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) &
+               & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) )
+            !
+            zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) &
+               &          ) * ( 1. - pamsk )
+            zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) &
+               &          ) * ( 1. - pamsk )
+            !
+            !                                  ! up & down beta terms
+            ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!)
+            IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt
+            ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig
+            ENDIF
+            !
+            IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt
+            ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig
+            ENDIF
+            !
+            ! if all the points are outside ice cover
+            IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig
+            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig            
+            !
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
@@ -1352,29 +1248,25 @@
       ! ---------------------------------
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) )
-               zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) )
-               zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) )
-               !
-               zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu )
-               !
-               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl)
-               !
-            END DO
-         END DO
-
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) )
-               zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
-               zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) )
-               !
-               zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv )
-               !
-               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl)
-               !
-            END DO
-         END DO
+         DO_2D_10_10
+            zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) )
+            zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) )
+            zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) )
+            !
+            zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu )
+            !
+            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl)
+            !
+         END_2D
+
+         DO_2D_10_10
+            zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) )
+            zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
+            zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) )
+            !
+            zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv )
+            !
+            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl)
+            !
+         END_2D
 
       END DO
@@ -1401,75 +1293,71 @@
       !
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.)   ! lateral boundary cond.
       
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
-               
-               Rjm = zslpx(ji-1,jj,jl)
-               Rj  = zslpx(ji  ,jj,jl)
-               Rjp = zslpx(ji+1,jj,jl)
-
-               IF( np_limiter == 3 ) THEN
-
-                  IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm
-                  ELSE                        ;   Rr = Rjp
+         DO_2D_00_00
+            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
+            
+            Rjm = zslpx(ji-1,jj,jl)
+            Rj  = zslpx(ji  ,jj,jl)
+            Rjp = zslpx(ji+1,jj,jl)
+
+            IF( np_limiter == 3 ) THEN
+
+               IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm
+               ELSE                        ;   Rr = Rjp
+               ENDIF
+
+               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)     
+               IF( Rj > 0. ) THEN
+                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  &
+                     &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
+               ELSE
+                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  &
+                     &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
+               ENDIF
+               pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter
+
+            ELSEIF( np_limiter == 2 ) THEN
+               IF( Rj /= 0. ) THEN
+                  IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
+                  ELSE                        ;   Cr = Rjp / Rj
                   ENDIF
-
-                  zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)     
-                  IF( Rj > 0. ) THEN
-                     zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  &
-                        &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
-                  ELSE
-                     zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  &
-                        &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
-                  ENDIF
-                  pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter
-
-               ELSEIF( np_limiter == 2 ) THEN
-                  IF( Rj /= 0. ) THEN
-                     IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
-                     ELSE                        ;   Cr = Rjp / Rj
-                     ENDIF
-                  ELSE
-                     Cr = 0.
-                  ENDIF
-
-                  ! -- superbee --
-                  zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
-                  ! -- van albada 2 --
-                  !!zpsi = 2.*Cr / (Cr*Cr+1.)
-                  ! -- sweby (with beta=1) --
-                  !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
-                  ! -- van Leer --
-                  !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
-                  ! -- ospre --
-                  !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
-                  ! -- koren --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
-                  ! -- charm --
-                  !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
-                  !ELSE                 ;   zpsi = 0.
-                  !ENDIF
-                  ! -- van albada 1 --
-                  !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
-                  ! -- smart --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
-                  ! -- umist --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
-
-                  ! high order flux corrected by the limiter
-                  pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5
-
+               ELSE
+                  Cr = 0.
                ENDIF
-            END DO
-         END DO
+
+               ! -- superbee --
+               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
+               ! -- van albada 2 --
+               !!zpsi = 2.*Cr / (Cr*Cr+1.)
+               ! -- sweby (with beta=1) --
+               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
+               ! -- van Leer --
+               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
+               ! -- ospre --
+               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
+               ! -- koren --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
+               ! -- charm --
+               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
+               !ELSE                 ;   zpsi = 0.
+               !ENDIF
+               ! -- van albada 1 --
+               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
+               ! -- smart --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
+               ! -- umist --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
+
+               ! high order flux corrected by the limiter
+               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5
+
+            ENDIF
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.)   ! lateral boundary cond.
@@ -1496,76 +1384,72 @@
       !
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.)   ! lateral boundary cond.
 
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj)
-
-               Rjm = zslpy(ji,jj-1,jl)
-               Rj  = zslpy(ji,jj  ,jl)
-               Rjp = zslpy(ji,jj+1,jl)
-
-               IF( np_limiter == 3 ) THEN
-
-                  IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm
-                  ELSE                        ;   Rr = Rjp
+         DO_2D_00_00
+            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj)
+
+            Rjm = zslpy(ji,jj-1,jl)
+            Rj  = zslpy(ji,jj  ,jl)
+            Rjp = zslpy(ji,jj+1,jl)
+
+            IF( np_limiter == 3 ) THEN
+
+               IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm
+               ELSE                        ;   Rr = Rjp
+               ENDIF
+
+               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)     
+               IF( Rj > 0. ) THEN
+                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  &
+                     &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
+               ELSE
+                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  &
+                     &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
+               ENDIF
+               pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter
+
+            ELSEIF( np_limiter == 2 ) THEN
+
+               IF( Rj /= 0. ) THEN
+                  IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
+                  ELSE                        ;   Cr = Rjp / Rj
                   ENDIF
-
-                  zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)     
-                  IF( Rj > 0. ) THEN
-                     zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  &
-                        &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
-                  ELSE
-                     zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  &
-                        &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
-                  ENDIF
-                  pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter
-
-               ELSEIF( np_limiter == 2 ) THEN
-
-                  IF( Rj /= 0. ) THEN
-                     IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
-                     ELSE                        ;   Cr = Rjp / Rj
-                     ENDIF
-                  ELSE
-                     Cr = 0.
-                  ENDIF
-
-                  ! -- superbee --
-                  zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
-                  ! -- van albada 2 --
-                  !!zpsi = 2.*Cr / (Cr*Cr+1.)
-                  ! -- sweby (with beta=1) --
-                  !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
-                  ! -- van Leer --
-                  !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
-                  ! -- ospre --
-                  !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
-                  ! -- koren --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
-                  ! -- charm --
-                  !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
-                  !ELSE                 ;   zpsi = 0.
-                  !ENDIF
-                  ! -- van albada 1 --
-                  !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
-                  ! -- smart --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
-                  ! -- umist --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
-
-                  ! high order flux corrected by the limiter
-                  pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5
-
+               ELSE
+                  Cr = 0.
                ENDIF
-            END DO
-         END DO
+
+               ! -- superbee --
+               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
+               ! -- van albada 2 --
+               !!zpsi = 2.*Cr / (Cr*Cr+1.)
+               ! -- sweby (with beta=1) --
+               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
+               ! -- van Leer --
+               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
+               ! -- ospre --
+               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
+               ! -- koren --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
+               ! -- charm --
+               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
+               !ELSE                 ;   zpsi = 0.
+               !ENDIF
+               ! -- van albada 1 --
+               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
+               ! -- smart --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
+               ! -- umist --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
+
+               ! high order flux corrected by the limiter
+               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5
+
+            ENDIF
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.)   ! lateral boundary cond.
@@ -1604,86 +1488,76 @@
       !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               !                               ! -- check h_ip -- !
+               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
+               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
+                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
+                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
+                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
+                  ENDIF
+               ENDIF
+               !
+               !                               ! -- check h_i -- !
+               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
+               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
+               ENDIF
+               !
+               !                               ! -- check h_s -- !
+               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
+               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
                   !
-                  !                               ! -- check h_ip -- !
-                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
-                  IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
-                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
-                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
-                        pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
-                     ENDIF
-                  ENDIF
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
                   !
-                  !                               ! -- check h_i -- !
-                  ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
-                  zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
-                  ENDIF
-                  !
-                  !                               ! -- check h_s -- !
-                  ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
-                  zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
-                     !
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     !
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
-                  ENDIF           
-                  !                  
-                  !                               ! -- check s_i -- !
-                  ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
-                  zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
-                  IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     zfra = psi_max(ji,jj,jl) / zsi
-                     sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
-                     psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
-                  ENDIF
-                  !
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
+               ENDIF           
+               !                  
+               !                               ! -- check s_i -- !
+               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
+               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
+               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = psi_max(ji,jj,jl) / zsi
+                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
+                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
                ENDIF
-            END DO
-         END DO
+               !
+            ENDIF
+         END_2D
       END DO 
       !
       !                                           ! -- check e_i/v_i -- !
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
-                     ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean
-                     zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl)
-                     IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                        zfra = pei_max(ji,jj,jk,jl) / zei
-                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                        pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean
+               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl)
+               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = pei_max(ji,jj,jk,jl) / zei
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra
+               ENDIF
+            ENDIF
+         END_3D
       END DO
       !                                           ! -- check e_s/v_s -- !
       DO jl = 1, jpl
-         DO jk = 1, nlay_s
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( pv_s(ji,jj,jl) > 0._wp ) THEN
-                     ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean
-                     zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl)
-                     IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                        zfra = pes_max(ji,jj,jk,jl) / zes
-                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                        pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_s )
+            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN
+               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean
+               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl)
+               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = pes_max(ji,jj,jk,jl) / zes
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra
+               ENDIF
+            ENDIF
+         END_3D
       END DO
       !
@@ -1718,23 +1592,21 @@
       ! -- check snow load -- !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
-                  !
-                  zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
-                  !
-                  IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
-                     ! put snow excess in the ocean
-                     zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     ! correct snow volume and heat content
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
-                  ENDIF
-                  !
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
+               !
+               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
+                  ! put snow excess in the ocean
+                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  ! correct snow volume and heat content
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
                ENDIF
-            END DO
-         END DO
+               !
+            ENDIF
+         END_2D
       END DO
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90	(revision 13469)
@@ -159,12 +159,10 @@
       npti = 0   ;   nptidx(:) = 0
       ipti = 0   ;   iptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               npti           = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( at_i(ji,jj) > epsi10 ) THEN
+            npti           = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
       
       !--------------------------------------------------------
@@ -777,22 +775,18 @@
       !                              !--------------------------------------------------!
       CASE( 1 )               !--- Spatial smoothing
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
-                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
-                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
-                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
-                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
-               ELSE
-                  zworka(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+               zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                  &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                  &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                  &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
+            ELSE
+               zworka(ji,jj) = 0._wp
+            ENDIF
+         END_2D
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               strength(ji,jj) = zworka(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            strength(ji,jj) = zworka(ji,jj)
+         END_2D
          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )
          !
@@ -803,17 +797,15 @@
          ENDIF
          !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
-                  itframe = 1 ! number of time steps for the running mean
-                  IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
-                  IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1
-                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe
-                  zstrp2  (ji,jj) = zstrp1  (ji,jj)
-                  zstrp1  (ji,jj) = strength(ji,jj)
-                  strength(ji,jj) = zp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+               itframe = 1 ! number of time steps for the running mean
+               IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
+               IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1
+               zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe
+               zstrp2  (ji,jj) = zstrp1  (ji,jj)
+               zstrp1  (ji,jj) = strength(ji,jj)
+               strength(ji,jj) = zp
+            ENDIF
+         END_2D
          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )
          !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90	(revision 13469)
@@ -182,10 +182,8 @@
       ! for diagnostics and convergence tests
       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
-            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
-         END DO
-      END DO
+      DO_2D_11_11
+         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
+         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
+      END_2D
       !
       !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization....
@@ -194,20 +192,16 @@
       !------------------------------------------------------------------------------!
       ! ocean/land mask
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1      ! NO vector opt.
-            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
+      END_2D
       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
 
       ! Lateral boundary conditions on velocity (modify zfmask)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF( zfmask(ji,jj) == 0._wp ) THEN
-               zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
-                  &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) )
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF( zfmask(ji,jj) == 0._wp ) THEN
+            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
+               &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) )
+         ENDIF
+      END_2D
       DO jj = 2, jpjm1
          IF( zfmask(1,jj) == 0._wp ) THEN
@@ -272,52 +266,50 @@
       zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-
-            ! ice fraction at U-V points
-            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ice/snow mass at U-V points
-            zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
-            zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
-            zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
-            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ocean currents at U-V points
-            v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
-            u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
-
-            ! Coriolis at T points (m*f)
-            zmf(ji,jj)      = zm1 * ff_t(ji,jj)
-
-            ! dt/m at T points (for alpha and beta coefficients)
-            zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
-            
-            ! m/dt
-            zmU_t(ji,jj)    = zmassU * z1_dtevp
-            zmV_t(ji,jj)    = zmassV * z1_dtevp
-            
-            ! Drag ice-atm.
-            ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
-            ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
-
-            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
-            zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
-            zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
-
-            ! masks
-            zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
-            zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
-
-            ! switches
-            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
-            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
-
-         END DO
-      END DO
+      DO_2D_00_00
+
+         ! ice fraction at U-V points
+         zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+         zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+         ! Ice/snow mass at U-V points
+         zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
+         zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
+         zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
+         zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+         zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+         ! Ocean currents at U-V points
+         v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
+         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
+
+         ! Coriolis at T points (m*f)
+         zmf(ji,jj)      = zm1 * ff_t(ji,jj)
+
+         ! dt/m at T points (for alpha and beta coefficients)
+         zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
+         
+         ! m/dt
+         zmU_t(ji,jj)    = zmassU * z1_dtevp
+         zmV_t(ji,jj)    = zmassV * z1_dtevp
+         
+         ! Drag ice-atm.
+         ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
+         ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
+
+         ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
+         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
+         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
+
+         ! masks
+         zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
+         zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
+
+         ! switches
+         IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
+         ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
+         IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
+         ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
+
+      END_2D
       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. )
       !
@@ -325,29 +317,25 @@
       !
       IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ! ice thickness at U-V points
-               zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-               zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-               ! ice-bottom stress at U points
-               zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj)
-               ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
-               ! ice-bottom stress at V points
-               zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj)
-               ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
-               ! ice_bottom stress at T points
-               zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj)
-               tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            ! ice thickness at U-V points
+            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+            ! ice-bottom stress at U points
+            zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj)
+            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
+            ! ice-bottom stress at V points
+            zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj)
+            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
+            ! ice_bottom stress at T points
+            zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj)
+            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )
          !
       ELSE                               !-- no landfast
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ztaux_base(ji,jj) = 0._wp
-               ztauy_base(ji,jj) = 0._wp
-            END DO
-         END DO
+         DO_2D_00_00
+            ztaux_base(ji,jj) = 0._wp
+            ztauy_base(ji,jj) = 0._wp
+         END_2D
       ENDIF
 
@@ -363,129 +351,117 @@
          ! convergence test
          IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
-                  zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_11_11
+               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
+               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
+            END_2D
          ENDIF
 
          ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
-         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points
-            DO ji = 1, jpim1
-
-               ! shear at F points
-               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            ! shear at F points
+            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. )
 
-         DO jj = 2, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12
-            DO ji = 2, jpi ! no vector loop
-
-               ! shear**2 at T points (doc eq. A16)
-               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-                  &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-              
-               ! divergence at T points
-               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-                  &    ) * r1_e1e2t(ji,jj)
-               zdiv2 = zdiv * zdiv
-               
-               ! tension at T points
-               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-                  &   ) * r1_e1e2t(ji,jj)
-               zdt2 = zdt * zdt
-               
-               ! delta at T points
-               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
-
-               ! P/delta at T points
-               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
-
-               ! alpha for aEVP
-               !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
-               !   alpha = beta = sqrt(4*gamma)
-               IF( ln_aEVP ) THEN
-                  zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
-                  z1_alph1 = 1._wp / ( zalph1 + 1._wp )
-                  zalph2   = zalph1
-                  z1_alph2 = z1_alph1
-                  ! explicit:
-                  ! z1_alph1 = 1._wp / zalph1
-                  ! z1_alph2 = 1._wp / zalph1
-                  ! zalph1 = zalph1 - 1._wp
-                  ! zalph2 = zalph1
-               ENDIF
-               
-               ! stress at T points (zkt/=0 if landfast)
-               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1
-               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
-             
-            END DO
-         END DO
+         DO_2D_01_01
+
+            ! shear**2 at T points (doc eq. A16)
+            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+           
+            ! divergence at T points
+            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+               &    ) * r1_e1e2t(ji,jj)
+            zdiv2 = zdiv * zdiv
+            
+            ! tension at T points
+            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+               &   ) * r1_e1e2t(ji,jj)
+            zdt2 = zdt * zdt
+            
+            ! delta at T points
+            zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
+
+            ! P/delta at T points
+            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
+
+            ! alpha for aEVP
+            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
+            !   alpha = beta = sqrt(4*gamma)
+            IF( ln_aEVP ) THEN
+               zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+               z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+               zalph2   = zalph1
+               z1_alph2 = z1_alph1
+               ! explicit:
+               ! z1_alph1 = 1._wp / zalph1
+               ! z1_alph2 = 1._wp / zalph1
+               ! zalph1 = zalph1 - 1._wp
+               ! zalph2 = zalph1
+            ENDIF
+            
+            ! stress at T points (zkt/=0 if landfast)
+            zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1
+            zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
+          
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. )
 
          ! Save beta at T-points for further computations
          IF( ln_aEVP ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
-               END DO
-            END DO
+            DO_2D_11_11
+               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+            END_2D
          ENDIF
          
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               ! alpha for aEVP
-               IF( ln_aEVP ) THEN
-                  zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) )
-                  z1_alph2 = 1._wp / ( zalph2 + 1._wp )
-                  ! explicit:
-                  ! z1_alph2 = 1._wp / zalph2
-                  ! zalph2 = zalph2 - 1._wp
-               ENDIF
-               
-               ! P/delta at F points
-               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
-               
-               ! stress at F points (zkt/=0 if landfast)
-               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            ! alpha for aEVP
+            IF( ln_aEVP ) THEN
+               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) )
+               z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+               ! explicit:
+               ! z1_alph2 = 1._wp / zalph2
+               ! zalph2 = zalph2 - 1._wp
+            ENDIF
+            
+            ! P/delta at F points
+            zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
+            
+            ! stress at F points (zkt/=0 if landfast)
+            zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
+
+         END_2D
 
          ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1               
-               !                   !--- U points
-               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
-                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
-                  &                    ) * r1_e2u(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
-                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
-                  &                  ) * r1_e1e2u(ji,jj)
-               !
-               !                !--- V points
-               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
-                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
-                  &                    ) * r1_e1v(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
-                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
-                  &                  ) * r1_e1e2v(ji,jj)
-               !
-               !                !--- ice currents at U-V point
-               v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1)
-               u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1)
-               !
-            END DO
-         END DO
+         DO_2D_00_00
+            !                   !--- U points
+            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
+               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
+               &                    ) * r1_e2u(ji,jj)                                                                      &
+               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
+               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
+               &                  ) * r1_e1e2u(ji,jj)
+            !
+            !                !--- V points
+            zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
+               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
+               &                    ) * r1_e1v(ji,jj)                                                                      &
+               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
+               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
+               &                  ) * r1_e1e2v(ji,jj)
+            !
+            !                !--- ice currents at U-V point
+            v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1)
+            u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1)
+            !
+         END_2D
          !
          ! --- Computation of ice velocity --- !
@@ -494,50 +470,48 @@
          IF( MOD(jter,2) == 0 ) THEN ! even iterations
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/v_ice
-                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at V-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
-                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
-                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
-                        &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                        &                                    ) / ( zbetav + 1._wp )                                              &
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )  * zmsk00y(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(v_oce - v_ice)
+               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/v_ice
+               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
+               zTauB = ztauy_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+               !
+               !                 !--- Coriolis at V-points (energy conserving formulation)
+               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
+                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
+                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
+                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
+                     &                                    ) / ( zbetav + 1._wp )                                              &
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00y(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
+                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            )  * zmsk00y(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )
             !
@@ -548,50 +522,48 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1          
-                  !                 !--- tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/u_ice
-                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
-                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
-                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
-                        &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                        &                                    ) / ( zbetau + 1._wp )                                              &
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &           )   * zmsk00x(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &           )   * zmsk00x(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(u_oce - u_ice)
+               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/u_ice
+               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
+               zTauB = ztaux_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+               !
+               !                 !--- Coriolis at U-points (energy conserving formulation)
+               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
+                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
+                     &                                    ) / ( zbetau + 1._wp )                                              &
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &           )   * zmsk00x(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &           )   * zmsk00x(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )
             !
@@ -604,50 +576,48 @@
          ELSE ! odd iterations
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/u_ice
-                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
-                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
-                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
-                        &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                        &                                    ) / ( zbetau + 1._wp )                                              &
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &           )   * zmsk00x(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00x(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(u_oce - u_ice)
+               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/u_ice
+               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
+               zTauB = ztaux_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+               !
+               !                 !--- Coriolis at U-points (energy conserving formulation)
+               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
+                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
+                     &                                    ) / ( zbetau + 1._wp )                                              &
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &           )   * zmsk00x(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00x(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )
             !
@@ -658,50 +628,48 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/v_ice
-                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at v-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
-                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
-                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
-                        &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                        &                                    ) / ( zbetav + 1._wp )                                              & 
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
-                        &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(v_oce - v_ice)
+               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/v_ice
+               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
+               zTauB = ztauy_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+               !
+               !                 !--- Coriolis at v-points (energy conserving formulation)
+               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
+                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
+                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
+                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
+                     &                                    ) / ( zbetav + 1._wp )                                              & 
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00y(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
+                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00y(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )
             !
@@ -725,44 +693,40 @@
       ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
       !------------------------------------------------------------------------------!
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-
-            ! shear at F points
-            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-         END DO
-      END DO           
+      DO_2D_10_10
+
+         ! shear at F points
+         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+            &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+      END_2D
       
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1 ! no vector loop
-            
-            ! tension**2 at T points
-            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-               &   ) * r1_e1e2t(ji,jj)
-            zdt2 = zdt * zdt
-            
-            ! shear**2 at T points (doc eq. A16)
-            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-            
-            ! shear at T points
-            pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
-
-            ! divergence at T points
-            pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-               &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-               &             ) * r1_e1e2t(ji,jj)
-            
-            ! delta at T points
-            zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
-            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
-            pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch
-
-         END DO
-      END DO
+      DO_2D_00_00
+         
+         ! tension**2 at T points
+         zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+            &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+            &   ) * r1_e1e2t(ji,jj)
+         zdt2 = zdt * zdt
+         
+         ! shear**2 at T points (doc eq. A16)
+         zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+            &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+            &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+         
+         ! shear at T points
+         pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
+
+         ! divergence at T points
+         pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+            &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+            &             ) * r1_e1e2t(ji,jj)
+         
+         ! delta at T points
+         zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
+         rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
+         pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch
+
+      END_2D
       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. )
       
@@ -802,13 +766,12 @@
          ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
          !         
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
-                  &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
-                  &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
-
-               zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
-
-               zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
+         DO_2D_00_00
+            zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
+               &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
+               &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
+
+            zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
+
+            zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
 
 !!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002)
@@ -816,9 +779,8 @@
 !!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress
 !!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11))
-               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
-               zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress
-               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
-            END DO
-         END DO
+            zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
+            zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress
+            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
+         END_2D
          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. )
          !
@@ -855,21 +817,19 @@
             &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
          !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ! 2D ice mass, snow mass, area transport arrays (X, Y)
-               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
-               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
-
-               zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
-               zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
-
-               zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
-               zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
-
-               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
-               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
-
-            END DO
-         END DO
+         DO_2D_00_00
+            ! 2D ice mass, snow mass, area transport arrays (X, Y)
+            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
+            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
+
+            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
+            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
+
+            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
+            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
+
+            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
+            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
+
+         END_2D
 
          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., &
@@ -957,10 +917,8 @@
          zresm = 0._wp
       ELSE
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
-                  &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)
-            END DO
-         END DO
+         DO_2D_11_11
+            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
+               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)
+         END_2D
          zresm = MAXVAL( zres )
          CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90	(revision 13469)
@@ -287,12 +287,10 @@
          ! select ice covered grid points
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
-                  npti         = npti  + 1
-                  nptidx(npti) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
+               npti         = npti  + 1
+               nptidx(npti) = (jj - 1) * jpi + ji
+            ENDIF
+         END_2D
 
          ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj)
@@ -344,38 +342,28 @@
          CALL ice_var_salprof ! for sz_i
          DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
-                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
-                  sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl)
-               END DO
-            END DO
+            DO_2D_11_11
+               v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
+               v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
+               sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl)
+            END_2D
          END DO
          !
          DO jl = 1, jpl
-            DO jk = 1, nlay_s
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl)
-                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * &
-                        &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_s )
+               t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl)
+               e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * &
+                  &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
+            END_3D
          END DO
          !
          DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
-                     ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
-                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
-                        &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + &
-                        &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) &
-                        &                       - rcp   * ( ztmelts - rt0 ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_i )
+               t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
+               ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
+               e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
+                  &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + &
+                  &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) &
+                  &                       - rcp   * ( ztmelts - rt0 ) )
+            END_3D
          END DO
 
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90	(revision 13469)
@@ -97,12 +97,10 @@
       !
       npti = 0   ;   nptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( at_i(ji,jj) > epsi10 ) THEN
+            npti = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
       
       !-----------------------------------------------------------------------------------------------
@@ -606,12 +604,10 @@
          !                    !---------------------------------------
          npti = 0   ;   nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
 !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) )
@@ -647,12 +643,10 @@
          !                    !-----------------------------------------
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90	(revision 13469)
@@ -77,10 +77,8 @@
       IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation
                                    CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
-               vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
-            END DO
-         END DO
+         DO_2D_00_00
+            utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+         END_2D
          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
       ENDIF
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90	(revision 13469)
@@ -209,5 +209,5 @@
       ! --- Ocean time step --- !
       !-------------------------!
-      IF( ln_icedyn )                   CALL ice_update_tau( kt, ub(:,:,1), vb(:,:,1) )   ! -- update surface ocean stresses
+      IF( ln_icedyn )                   CALL ice_update_tau( kt, uu(:,:,1,Nnn), vv(:,:,1,Nnn) )   ! -- update surface ocean stresses
 !!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90	(revision 13469)
@@ -120,19 +120,15 @@
          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
-                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
-                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
+               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
+               &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
+         END_2D
       ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
-                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
-                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
+               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
+               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
+         END_2D
       ENDIF
       CALL lbc_lnk( 'icethd', zfric, 'T',  1. )
@@ -141,51 +137,49 @@
       ! Partial computation of forcing for the thermodynamic sea ice model
       !--------------------------------------------------------------------!
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
-            !
-            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
-            !           !  practically no "direct lateral ablation"
-            !           
-            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
-            !           !  temperature and turbulent mixing (McPhee, 1992)
-            !
-            ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- !
-            zqld =  tmask(ji,jj,1) * rdt_ice *  &
-               &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  &
-               &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
-
-            ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- !
-            zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
-            zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0
-
-            ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2)
-            zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
-            qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
-
-            qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-            ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
-            !                              the freezing point, so that we do not have SST < T_freeze
-            !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
-
-            !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice
-            qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
-
-            ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 
-            ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget
-            IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN
-               IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
-               ELSE                    ;   fhld(ji,jj) = 0._wp
-               ENDIF
-               qlead(ji,jj) = 0._wp
-            ELSE
-               fhld (ji,jj) = 0._wp
+      DO_2D_11_11
+         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
+         !
+         !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+         !           !  practically no "direct lateral ablation"
+         !           
+         !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+         !           !  temperature and turbulent mixing (McPhee, 1992)
+         !
+         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- !
+         zqld =  tmask(ji,jj,1) * rdt_ice *  &
+            &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  &
+            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+         ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- !
+         zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
+         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0
+
+         ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2)
+         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
+         qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
+
+         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+         !                              the freezing point, so that we do not have SST < T_freeze
+         !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
+
+         !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice
+         qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
+
+         ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 
+         ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget
+         IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN
+            IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
+            ELSE                    ;   fhld(ji,jj) = 0._wp
             ENDIF
-            !
-            ! Net heat flux on top of the ice-ocean [W.m-2]
-            ! ---------------------------------------------
-            qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
-         END DO
-      END DO
+            qlead(ji,jj) = 0._wp
+         ELSE
+            fhld (ji,jj) = 0._wp
+         ENDIF
+         !
+         ! Net heat flux on top of the ice-ocean [W.m-2]
+         ! ---------------------------------------------
+         qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
+      END_2D
       
       ! In case we bypass open-water ice formation
@@ -215,12 +209,10 @@
          ! select ice covered grid points
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
-                  npti         = npti  + 1
-                  nptidx(npti) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
+               npti         = npti  + 1
+               nptidx(npti) = (jj - 1) * jpi + ji
+            ENDIF
+         END_2D
 
          IF( npti > 0 ) THEN  ! If there is no ice, do nothing.
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90	(revision 13469)
@@ -114,67 +114,65 @@
       ENDIF
       
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-
-            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
-            !---------------------------------------------------
-            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
-
-            ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
-            !---------------------------------------------------
-            zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
-            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr
-
-            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
-            !----------------------------------------------------------------------
-            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   &
-               &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
-
-            ! New qsr and qns used to compute the oceanic heat flux at the next time step
-            !----------------------------------------------------------------------------
-            qsr(ji,jj) = zqsr                                      
-            qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr              
-
-            ! Mass flux at the atm. surface       
-            !-----------------------------------
-            wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
-
-            ! Mass flux at the ocean surface      
-            !------------------------------------
-            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
-            !  ------------------------------------------------------------------------------------- 
-            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
-            !  Thus  FW  flux  =  External ( E-P+snow melt)
-            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
-            !                     Associated to Ice formation AND Ice melting
-            !                     Even if i see Ice melting as a FW and SALT flux
-            !        
-            ! mass flux from ice/ocean
-            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
-               &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
-
-            ! add the snow melt water to snow mass flux to the ocean
-            wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
-
-            ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
-
-
-            ! Salt flux at the ocean surface      
-            !------------------------------------------
-            sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
-               &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
-            
-            ! Mass of snow and ice per unit area   
-            !----------------------------------------
-            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
-            !                                               ! new mass per unit area
-            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  ) 
-            !                                               ! time evolution of snow+ice mass
-            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice
-            
-         END DO
-      END DO
+      DO_2D_11_11
+
+         ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
+         !---------------------------------------------------
+         zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
+
+         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
+         !---------------------------------------------------
+         zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr
+
+         ! Add the residual from heat diffusion equation and sublimation (W.m-2)
+         !----------------------------------------------------------------------
+         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   &
+            &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
+
+         ! New qsr and qns used to compute the oceanic heat flux at the next time step
+         !----------------------------------------------------------------------------
+         qsr(ji,jj) = zqsr                                      
+         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr              
+
+         ! Mass flux at the atm. surface       
+         !-----------------------------------
+         wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
+
+         ! Mass flux at the ocean surface      
+         !------------------------------------
+         !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
+         !  ------------------------------------------------------------------------------------- 
+         !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
+         !  Thus  FW  flux  =  External ( E-P+snow melt)
+         !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
+         !                     Associated to Ice formation AND Ice melting
+         !                     Even if i see Ice melting as a FW and SALT flux
+         !        
+         ! mass flux from ice/ocean
+         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
+            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
+
+         ! add the snow melt water to snow mass flux to the ocean
+         wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
+
+         ! mass flux at the ocean/ice interface
+         fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
+         emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+
+
+         ! Salt flux at the ocean surface      
+         !------------------------------------------
+         sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
+            &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
+         
+         ! Mass of snow and ice per unit area   
+         !----------------------------------------
+         snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
+         !                                               ! new mass per unit area
+         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  ) 
+         !                                               ! time evolution of snow+ice mass
+         snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice
+         
+      END_2D
 
       ! Storing the transmitted variables
@@ -335,16 +333,14 @@
       !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
-         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-            DO ji = fs_2, fs_jpim1
-               !                                               ! 2*(U_ice-U_oce) at T-point
-               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
-               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
-               !                                              ! |U_ice-U_oce|^2
-               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
-               !                                               ! update the ocean stress modulus
-               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
-               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
-            END DO
-         END DO
+         DO_2D_00_00
+            !                                               ! 2*(U_ice-U_oce) at T-point
+            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
+            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+            !                                              ! |U_ice-U_oce|^2
+            zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
+            !                                               ! update the ocean stress modulus
+            taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
+            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+         END_2D
          CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. )
          !
@@ -363,19 +359,17 @@
       ENDIF
       !
-      DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle
-         DO ji = fs_2, fs_jpim1   ! Vect. Opt.   
-            ! ice area at u and v-points 
-            zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
-               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
-            zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  &
-               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) )
-            !                                                   ! linearized quadratic drag formulation
-            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) )
-            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) )
-            !                                                   ! stresses at the ocean surface
-            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
-            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
-         END DO
-      END DO
+      DO_2D_00_00
+         ! ice area at u and v-points 
+         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
+            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
+         zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  &
+            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) )
+         !                                                   ! linearized quadratic drag formulation
+         zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) )
+         zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) )
+         !                                                   ! stresses at the ocean surface
+         utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
+         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
+      END_2D
       CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90	(revision 13469)
@@ -263,22 +263,18 @@
       zlay_i   = REAL( nlay_i , wp )    ! number of layers
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
-                     !
-                     ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3]
-                     ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C]
-                     ! Conversion q(S,T) -> T (second order equation)
-                     zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus
-                     zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) )
-                     t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts
-                     !
-                  ELSE                                   !--- no ice
-                     t_i(ji,jj,jk,jl) = rt0
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
+               !
+               ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3]
+               ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C]
+               ! Conversion q(S,T) -> T (second order equation)
+               zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus
+               zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) )
+               t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts
+               !
+            ELSE                                   !--- no ice
+               t_i(ji,jj,jk,jl) = rt0
+            ENDIF
+         END_3D
       END DO
 
@@ -372,25 +368,19 @@
          z1_dS = 1._wp / ( zsi1 - zsi0 )
          DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
-                  !                             ! force a constant profile when SSS too low (Baltic Sea)
-                  IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
-               END DO
-            END DO
+            DO_2D_11_11
+               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
+               !                             ! force a constant profile when SSS too low (Baltic Sea)
+               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
+            END_2D
          END DO
          !
          ! Computation of the profile
          DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !                          ! linear profile with 0 surface value
-                     zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
-                     zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile
-                     sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_i )
+               !                          ! linear profile with 0 surface value
+               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
+               zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile
+               sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
+            END_3D
          END DO
          !
@@ -517,52 +507,42 @@
          ! Zap ice energy and use ocean heat to melt ice
          !-----------------------------------------------------------------
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj)
-                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, nlay_s
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
-                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj)
-                  t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            ! update exchanges with ocean
+            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
+            e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj)
+            t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+         END_3D
+         !
+         DO_3D_11_11( 1, nlay_s )
+            ! update exchanges with ocean
+            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
+            e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj)
+            t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+         END_3D
          !
          !-----------------------------------------------------------------
          ! zap ice and snow volume, add water and salt to ocean
          !-----------------------------------------------------------------
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               ! update exchanges with ocean
-               sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice
-               !
-               a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
-               v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
-               v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj)
-               t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) )
-               oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj)
-               sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj)
-               !
-               h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj)
-               h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj)
-               !
-               a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj)
-               v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj)
-               v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj)
-               !
-            END DO
-         END DO
+         DO_2D_11_11
+            ! update exchanges with ocean
+            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice
+            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice
+            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice
+            !
+            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
+            v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
+            v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj)
+            t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) )
+            oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj)
+            sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj)
+            !
+            h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj)
+            h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj)
+            !
+            a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj)
+            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj)
+            v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj)
+            !
+         END_2D
          !
       END DO 
@@ -617,45 +597,35 @@
          ! zap ice energy and send it to the ocean
          !----------------------------------------
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                     hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0
-                     pe_i(ji,jj,jk,jl) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, nlay_s
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                     hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0
-                     pe_s(ji,jj,jk,jl) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0
+               pe_i(ji,jj,jk,jl) = 0._wp
+            ENDIF
+         END_3D
+         !
+         DO_3D_11_11( 1, nlay_s )
+            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0
+               pe_s(ji,jj,jk,jl) = 0._wp
+            ENDIF
+         END_3D
          !
          !-----------------------------------------------------
          ! zap ice and snow volume, add water and salt to ocean
          !-----------------------------------------------------
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                  wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt
-                  pv_i   (ji,jj,jl) = 0._wp
-               ENDIF
-               IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                  wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt
-                  pv_s   (ji,jj,jl) = 0._wp
-               ENDIF
-               IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
-                  sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
-                  psv_i  (ji,jj,jl) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt
+               pv_i   (ji,jj,jl) = 0._wp
+            ENDIF
+            IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt
+               pv_s   (ji,jj,jl) = 0._wp
+            ENDIF
+            IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
+               sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
+               psv_i  (ji,jj,jl) = 0._wp
+            ENDIF
+         END_2D
          !
       END DO 
Index: /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90	(revision 13469)
@@ -69,19 +69,15 @@
 
       ! tresholds for outputs
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
-            zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
-            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
-            zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06  ) ) ! 1 if snow   , 0 if no snow
-         END DO
-      END DO
+      DO_2D_11_11
+         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
+         zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
+         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
+         zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06  ) ) ! 1 if snow   , 0 if no snow
+      END_2D
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-               zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
-            END DO
-         END DO
+         DO_2D_11_11
+            zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+            zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
+         END_2D
       END DO
 
@@ -134,11 +130,9 @@
       !
       IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1
-               z2da  = u_ice(ji,jj) + u_ice(ji-1,jj)
-               z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
-               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
-           END DO
-         END DO
+         DO_2D_00_00
+            z2da  = u_ice(ji,jj) + u_ice(ji-1,jj)
+            z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
+            z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
+         END_2D
          CALL lbc_lnk( 'icewri', z2d, 'T', 1. )
          CALL iom_put( 'icevel', z2d )
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdydta.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdydta.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdydta.F90	(revision 13469)
@@ -145,5 +145,5 @@
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                        dta_bdy(jbdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)         
+                        dta_bdy(jbdy)%u3d(ib,ik) =  ( uu(ii,ij,ik,Nii) - un_b(ii,ij) ) * umask(ii,ij,ik)         
                      END DO
                   END DO
@@ -153,5 +153,5 @@
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
+                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vv(ii,ij,ik,Nii) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
                      END DO
                   END DO
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90	(revision 13469)
@@ -140,10 +140,8 @@
                                        ! Read in masks to define closed seas and lakes 
       !
-      DO jj = 1, jpj                   ! depth of the iceshelves
-         DO ji = 1, jpi
-            ik = mikt(ji,jj)
-            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
-         END DO
-      END DO
+      DO_2D_11_11
+         ik = mikt(ji,jj)
+         risfdep(ji,jj) = gdepw_0(ji,jj,ik)
+      END_2D
       !
       ht_0(:,:) = 0._wp  ! Reference ocean thickness
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90	(revision 13469)
@@ -253,29 +253,23 @@
          IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg
             CALL wad_spg( sshn, zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1                ! SPG with the application of W/D gravity filters
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
+                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
+                  &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
+            END_2D
          ELSE                                      ! now suface pressure gradient
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
-               END DO
-            END DO
-         ENDIF
-         !
-      ENDIF
-      !
-      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
-         DO ji = fs_2, fs_jpim1
-             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
-             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
-          END DO
-      END DO 
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
+            END_2D
+         ENDIF
+         !
+      ENDIF
+      !
+      DO_2D_00_00
+          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
+      END_2D
       !
       !                                   !=  Add bottom stress contribution from baroclinic velocities  =!
@@ -287,20 +281,16 @@
       IF( ln_apr_dyn ) THEN
          IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2)
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
          ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW)
             zztmp = grav * r1_2
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  &
-                       &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  &
-                       &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF 
       ENDIF
@@ -309,18 +299,14 @@
       !                                   !  ----------------------------------  !
       IF( ln_bt_fw ) THEN                        ! Add wind forcing
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj)
+         END_2D
       ELSE
          zztmp = r1_rau0 * r1_2
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj)
+         END_2D
       ENDIF  
       !
@@ -457,18 +443,14 @@
             !
             !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk)
-            DO jj = 1, jpj
-               DO ji = 1, jpim1   ! not jpi-column
-                  zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
-                       &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                       &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-               END DO
-            END DO
-            DO jj = 1, jpjm1        ! not jpj-row
-               DO ji = 1, jpi
-                  zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
-                       &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                       &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
-               END DO
-            END DO
+            DO_2D_11_10
+               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
+                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+            END_2D
+            DO_2D_10_11
+               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
+                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+            END_2D
             !
          ENDIF
@@ -526,10 +508,8 @@
          !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --!
          !-------------------------------------------------------------------------!
-         DO jj = 2, jpjm1        ! INNER domain                             
-            DO ji = 2, jpim1
-               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
-               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
+            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
+         END_2D
          !
          CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
@@ -553,14 +533,12 @@
          ! Sea Surface Height at u-,v-points (vvl case only)
          IF( .NOT.ln_linssh ) THEN                                
-            DO jj = 2, jpjm1   ! INNER domain, will be extended to whole domain later
-               DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
+            END_2D
          ENDIF   
          !         
@@ -575,10 +553,8 @@
          !                             ! Surface pressure gradient
          zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor
-         DO jj = 2, jpjm1                            
-            DO ji = 2, jpim1
-               zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-               zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+         END_2D
          IF( ln_wd_il ) THEN        ! W/D : gravity filters applied on pressure gradient
             CALL wad_spg( zsshp2_e, zcpx, zcpy )   ! Calculating W/D gravity filters
@@ -595,10 +571,8 @@
          ! Add tidal astronomical forcing if defined
          IF ( ln_tide .AND. ln_tide_pot ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF
          !
@@ -606,10 +580,8 @@
 !jth do implicitly instead
          IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
+            END_2D
          ENDIF
          !
@@ -626,53 +598,47 @@
          !------------------------------------------------------------------------------------------------------------------------!
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
-                            &     + rdtbt * (                   zu_spg(ji,jj)   &
-                            &                                 + zu_trd(ji,jj)   &
-                            &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * ssumask(ji,jj)
-
-                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
-                            &     + rdtbt * (                   zv_spg(ji,jj)   &
-                            &                                 + zv_trd(ji,jj)   &
-                            &                                 + zv_frc(ji,jj) ) &
-                            &   ) * ssvmask(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
+                         &     + rdtbt * (                   zu_spg(ji,jj)   &
+                         &                                 + zu_trd(ji,jj)   &
+                         &                                 + zu_frc(ji,jj) ) & 
+                         &   ) * ssumask(ji,jj)
+
+               va_e(ji,jj) = (                                 vn_e(ji,jj)   &
+                         &     + rdtbt * (                   zv_spg(ji,jj)   &
+                         &                                 + zv_trd(ji,jj)   &
+                         &                                 + zv_frc(ji,jj) ) &
+                         &   ) * ssvmask(ji,jj)
+            END_2D
             !
          ELSE                           !* Flux form
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
-                  !                    ! backward interpolated depth used in spg terms at jn+1/2
-                  zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
-                       &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-                  zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
-                       &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
-                  !                    ! inverse depth at jn+1
-                  z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
-                  z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
-                  !
-                  ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
-                       &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   !
-                       &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
-                       &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu
-                  !
-                  va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
-                       &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   !
-                       &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
-                       &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv
-               END DO
-            END DO
+            DO_2D_00_00
+               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
+               !                    ! backward interpolated depth used in spg terms at jn+1/2
+               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
+                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
+                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+               !                    ! inverse depth at jn+1
+               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
+               z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
+               !
+               ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
+                    &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   !
+                    &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
+                    &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu
+               !
+               va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
+                    &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   !
+                    &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
+                    &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv
+            END_2D
          ENDIF
 !jth implicit bottom friction:
          IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj))
-                     va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj))
-               END DO
-            END DO
+            DO_2D_00_00
+                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj))
+                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj))
+            END_2D
          ENDIF
        
@@ -737,19 +703,17 @@
       IF (ln_bt_fw) THEN
          IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zun_save = un_adv(ji,jj)
-                  zvn_save = vn_adv(ji,jj)
-                  !                          ! apply the previously computed correction 
-                  un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - atfp * un_bf(ji,jj) )
-                  vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - atfp * vn_bf(ji,jj) )
-                  !                          ! Update corrective fluxes for next time step
-                  un_bf(ji,jj)  = atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) )
-                  vn_bf(ji,jj)  = atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) )
-                  !                          ! Save integrated transport for next computation
-                  ub2_b(ji,jj) = zun_save
-                  vb2_b(ji,jj) = zvn_save
-               END DO
-            END DO
+            DO_2D_11_11
+               zun_save = un_adv(ji,jj)
+               zvn_save = vn_adv(ji,jj)
+               !                          ! apply the previously computed correction 
+               un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - atfp * un_bf(ji,jj) )
+               vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - atfp * vn_bf(ji,jj) )
+               !                          ! Update corrective fluxes for next time step
+               un_bf(ji,jj)  = atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) )
+               vn_bf(ji,jj)  = atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) )
+               !                          ! Save integrated transport for next computation
+               ub2_b(ji,jj) = zun_save
+               vb2_b(ji,jj) = zvn_save
+            END_2D
          ELSE
             un_bf(:,:) = 0._wp            ! corrective fluxes for next time step set to zero
@@ -770,14 +734,12 @@
       ELSE
          ! At this stage, ssha has been corrected: compute new depths at velocity points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
-                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      &
-                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
-                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      &
-                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
-            END DO
-         END DO
+         DO_2D_10_10
+            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
+               &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      &
+               &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
+            zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
+               &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      &
+               &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
+         END_2D
          CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
          !
@@ -794,6 +756,6 @@
       ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)  
       DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
+         uu(:,:,jk,Nii) = ( uu(:,:,jk,Nii) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk)
+         vv(:,:,jk,Nii) = ( vv(:,:,jk,Nii) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
       END DO
 
@@ -802,8 +764,8 @@
          CALL lbc_lnk_multi( 'dynspg_ts', zuwdav2, 'U', 1._wp, zvwdav2, 'V', 1._wp)
          DO jk = 1, jpkm1
-            un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) &
-                       & + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk) 
-            vn(:,:,jk) = ( vn_adv(:,:)*r1_hv_n(:,:) & 
-                       & + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)  
+            uu(:,:,jk,Nii) = ( un_adv(:,:)*r1_hu_n(:,:) &
+                       & + zuwdav2(:,:)*(uu(:,:,jk,Nii) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk) 
+            vv(:,:,jk,Nii) = ( vn_adv(:,:)*r1_hv_n(:,:) & 
+                       & + zvwdav2(:,:)*(vv(:,:,jk,Nii) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)  
          END DO
       END IF 
@@ -1007,11 +969,9 @@
       ! Max courant number for ext. grav. waves
       !
-      DO jj = 1, jpj
-         DO ji =1, jpi
-            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
-            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
-            zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
-         END DO
-      END DO
+      DO_2D_11_11
+         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+         zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
+      END_2D
       !
       zcmax = MAXVAL( zcu(:,:) )
@@ -1133,45 +1093,37 @@
          SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
-                       &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
+                    &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
-                       &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   &
-                       &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
-                       &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
+                    &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   &
+                    &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
+                    &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
          END SELECT
          CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp )
          !
          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-               ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-               ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-               ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-            END DO
-         END DO
+         DO_2D_01_01
+            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+            ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+            ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+         END_2D
          !
       CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme)
          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) )
-               ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
-               ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
-               ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
-               ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
-            END DO
-         END DO
+         DO_2D_01_01
+            z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) )
+            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
+            ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
+            ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
+            ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
+         END_2D
          !
       CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT !
@@ -1200,12 +1152,10 @@
             !
             !zhf(:,:) = hbatf(:,:)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
-                       &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
-                       &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
-                       &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
-               END DO
-            END DO
+            DO_2D_10_10
+               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
+                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
+                    &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
+                    &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
+            END_2D
          ENDIF
          !
@@ -1221,9 +1171,7 @@
          CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )
          ! JC: TBC. hf should be greater than 0 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
+         END_2D
          zwz(:,:) = ff_f(:,:) * zwz(:,:)
       END SELECT
@@ -1246,56 +1194,48 @@
       SELECT CASE( nvor_scheme )
       CASE( np_ENT )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) )
-               z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) )
-               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
-                  &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   &
-                  &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   )
-                  !
-               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
-                  &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   & 
-                  &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   ) 
-            END DO  
-         END DO  
+         DO_2D_00_00
+            z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) )
+            z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) )
+            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
+               &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   &
+               &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   )
+               !
+            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
+               &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   & 
+               &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   ) 
+         END_2D
          !         
       CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
-               zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
-               zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               ! energy conserving formulation for planetary vorticity term
-               zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-            END DO
-         END DO
+         DO_2D_00_00
+            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
+            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
+            zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            ! energy conserving formulation for planetary vorticity term
+            zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+         END_2D
          !
       CASE( np_ENS )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
-                 &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
-                 &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
+              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
+              &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+         END_2D
          !
       CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)         
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
-                &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
-                &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
-                &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
-               zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
-                &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
-                &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
-                &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
+             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
+             &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
+             &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
+            zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
+             &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
+             &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
+             &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
+         END_2D
          !
       END SELECT
@@ -1322,24 +1262,20 @@
       !
       IF( ln_wd_dl_rmp ) THEN     
-         DO jj = 1, jpj
-            DO ji = 1, jpi                    
-               IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
-                  !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN 
-                  ptmsk(ji,jj) = 1._wp
-               ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN
-                  ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) )
-               ELSE 
-                  ptmsk(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
+               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN 
+               ptmsk(ji,jj) = 1._wp
+            ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN
+               ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) )
+            ELSE 
+               ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
       ELSE  
-         DO jj = 1, jpj
-            DO ji = 1, jpi                              
-               IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp
-               ELSE                                                 ;   ptmsk(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp
+            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
       ENDIF
       !
@@ -1365,23 +1301,19 @@
       !!----------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpim1   ! not jpi-column
-            IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj) 
-            ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)  
-            ENDIF
-            phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj)
-            pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj)
-         END DO
-      END DO
-      !
-      DO jj = 1, jpjm1   ! not jpj-row
-         DO ji = 1, jpi
-            IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  )
-            ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)  
-            ENDIF
-            phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj) 
-            pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj)
-         END DO
-      END DO
+      DO_2D_11_10
+         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj) 
+         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)  
+         ENDIF
+         phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj)
+         pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj)
+      END_2D
+      !
+      DO_2D_10_11
+         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  )
+         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)  
+         ENDIF
+         phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj) 
+         pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj)
+      END_2D
       !
    END SUBROUTINE wad_Umsk
@@ -1399,44 +1331,42 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy
       !!----------------------------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1 
-            ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
-                 &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
-                 &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                 &                                                         > rn_wdmin1 + rn_wdmin2
-            ll_tmp2 = ( ABS( sshn(ji+1,jj)            -  sshn(ji  ,jj))  > 1.E-12 ).AND.( &
-                 &      MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                 &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-            IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-            ELSEIF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                    &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-               zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-            ELSE
-               zcpx(ji,jj) = 0._wp
-            ENDIF
-            !
-            ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji,jj+1) ) >                &
-                 &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
-                 &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                 &                                                       > rn_wdmin1 + rn_wdmin2
-            ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji,jj+1))  > 1.E-12 ).AND.( &
-                 &      MAX(   sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                 &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-            
-            IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-            ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                    &             / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-               zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
-            ELSE
-               zcpy(ji,jj) = 0._wp
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+              &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
+              &                                                         > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( sshn(ji+1,jj)            -  sshn(ji  ,jj))  > 1.E-12 ).AND.( &
+              &      MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+         IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+         ELSEIF(ll_tmp2) THEN
+            ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
+                 &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
+            zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+         ELSE
+            zcpx(ji,jj) = 0._wp
+         ENDIF
+         !
+         ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji,jj+1) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+              &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
+              &                                                       > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji,jj+1))  > 1.E-12 ).AND.( &
+              &      MAX(   sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+         
+         IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+         ELSE IF(ll_tmp2) THEN
+            ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
+                 &             / (sshn(ji,jj+1) - sshn(ji,jj  )) )
+            zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
+         ELSE
+            zcpy(ji,jj) = 0._wp
+         ENDIF
+      END_2D
             
    END SUBROUTINE wad_spg
@@ -1467,17 +1397,13 @@
       IF( ln_isfcav.OR.ln_drgice_imp ) THEN          ! top+bottom friction (ocean cavities)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1     ! INNER domain
-               pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
-               pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
+         END_2D
       ELSE                          ! bottom friction only
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1  ! INNER domain
-               pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
-               pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
+         END_2D
       ENDIF
       !
@@ -1486,42 +1412,34 @@
       IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1  ! INNER domain
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zu_i(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj)
-               zv_i(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = uu(ji,jj,ikbu,Nii) - un_b(ji,jj)
+            zv_i(ji,jj) = vv(ji,jj,ikbv,Nii) - vn_b(ji,jj)
+         END_2D
       ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! INNER domain
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zu_i(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj)
-               zv_i(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = uu(ji,jj,ikbu,Nnn) - ub_b(ji,jj)
+            zv_i(ji,jj) = vv(ji,jj,ikbv,Nnn) - vb_b(ji,jj)
+         END_2D
       ENDIF
       !
       IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please !
          zztmp = -1._wp / rdtbt
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
-                    &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
-                    &                              r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
+                 &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
+                 &                              r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
+         END_2D
       ELSE                    ! use "unclipped" drag (even if explicit friction is used in 3D calculation)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
+         END_2D
       END IF
       !
@@ -1532,32 +1450,26 @@
          IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity
             
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! INNER domain
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zu_i(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj)
-                  zv_i(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = uu(ji,jj,iktu,Nii) - un_b(ji,jj)
+               zv_i(ji,jj) = vv(ji,jj,iktv,Nii) - vn_b(ji,jj)
+            END_2D
          ELSE                                ! CENTRED integration: use BEFORE top baroclinic velocity
             
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1      ! INNER domain
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zu_i(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj)
-                  zv_i(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = uu(ji,jj,iktu,Nnn) - ub_b(ji,jj)
+               zv_i(ji,jj) = vv(ji,jj,iktv,Nnn) - vb_b(ji,jj)
+            END_2D
          ENDIF
          !
          !                    ! use "unclipped" top drag (even if explicit friction is used in 3D calculation)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
+         END_2D
          !
       ENDIF
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynzdf.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynzdf.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynzdf.F90	(revision 13469)
@@ -110,12 +110,12 @@
       IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
          DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk)
-            va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk)
+            ua(:,:,jk) = ( uu(:,:,jk,Nnn) + r2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vv(:,:,jk,Nnn) + r2dt * va(:,:,jk) ) * vmask(:,:,jk)
          END DO
       ELSE                                      ! applied on thickness weighted velocity
          DO jk = 1, jpkm1
-            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
+            ua(:,:,jk) = (         e3u_b(:,:,jk) * uu(:,:,jk,Nnn)  &
                &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
-            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
+            va(:,:,jk) = (         e3v_b(:,:,jk) * vv(:,:,jk,Nnn)  &
                &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
          END DO
@@ -131,25 +131,21 @@
             va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
          END DO
-         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
-               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+         DO_2D_00_00
+            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+            ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
+            ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua
+            va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va
+         END_2D
+         IF( ln_isfcav.OR.ln_drgice_imp ) THEN    ! Ocean cavities (ISF)
+            DO_2D_00_00
+               iku = miku(ji,jj)         ! top ocean level at u- and v-points 
+               ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua
-               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va
-            END DO
-         END DO
-         IF( ln_isfcav.OR.ln_drgice_imp ) THEN    ! Ocean cavities (ISF)
-            DO jj = 2, jpjm1        
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  iku = miku(ji,jj)         ! top ocean level at u- and v-points 
-                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-                  ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua
-                  va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va
-               END DO
-            END DO
+               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua
+               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va
+            END_2D
          END IF
       ENDIF
@@ -162,83 +158,63 @@
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw_n(ji,jj,2) ) * wumask(ji,jj,2)
-               zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)
+            zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw_n(ji,jj,2) ) * wumask(ji,jj,2)
+            zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -251,20 +227,16 @@
       !
       IF ( ln_drgimp ) THEN      ! implicit bottom friction
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
+         DO_2D_00_00
+            iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
+            zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
+         END_2D
+         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN   ! top friction (always implicit)
+            DO_2D_00_00
+               !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
+               iku = miku(ji,jj)       ! ocean top level at u- and v-points 
                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
-            END DO
-         END DO
-         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN   ! top friction (always implicit)
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
-                  iku = miku(ji,jj)       ! ocean top level at u- and v-points 
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
-               END DO
-            END DO
+               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
+            END_2D
          END IF
       ENDIF
@@ -285,39 +257,23 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
-            ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
+         ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+            &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
+      END_2D
+      DO_3D_00_00( 2, jpkm1 )
+         ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3D_00_00( jpk-2, 1, -1 )
+         ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+      END_3D
       !
       !              !==  Vertical diffusion on v  ==!
@@ -328,83 +284,63 @@
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzv)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw_n(ji,jj,2) ) * wvmask(ji,jj,2)
-               zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)
+            zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw_n(ji,jj,2) ) * wvmask(ji,jj,2)
+            zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1        !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -416,19 +352,15 @@
       !
       IF( ln_drgimp ) THEN
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+         DO_2D_00_00
+            ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
+            zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
+         END_2D
+         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN
+            DO_2D_00_00
+               ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
-            END DO
-         END DO
-         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-                  zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
-               END DO
-            END DO
+               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
+            END_2D
          ENDIF
       ENDIF
@@ -449,43 +381,27 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.          
-            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
-            va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
-               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
+         va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+            &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
+      END_2D
+      DO_3D_00_00( 2, jpkm1 )
+         va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3D_00_00( jpk-2, 1, -1 )
+         va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+      END_3D
       !
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
-         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
+         ztrdu(:,:,:) = ( ua(:,:,:) - uu(:,:,:,Nnn) ) / r2dt - ztrdu(:,:,:)
+         ztrdv(:,:,:) = ( va(:,:,:) - vv(:,:,:,Nnn) ) / r2dt - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
          DEALLOCATE( ztrdu, ztrdv ) 
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_oce.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_oce.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_oce.F90	(revision 13469)
@@ -209,12 +209,10 @@
       !!---------------------------------------------------------------------
       zcoef = 0.5 / ( zrhoa * zcdrag ) 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-            ztau = SQRT( ztx * ztx + zty * zty )
-            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+         zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+         ztau = SQRT( ztx * ztx + zty * zty )
+         wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. )
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk.F90	(revision 13469)
@@ -408,17 +408,13 @@
 #if defined key_cyclone
       CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
-            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
-         END DO
-      END DO
+      DO_2D_00_00
+         sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
+         sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
+      END_2D
 #endif
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
-         END DO
-      END DO
+      DO_2D_00_00
+         zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+         zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+      END_2D
       CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
@@ -474,12 +470,10 @@
 !!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef.
 
-      DO jj = 1, jpj             ! tau module, i and j component
-         DO ji = 1, jpi
-            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
-            taum  (ji,jj) = zztmp * wndm  (ji,jj)
-            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
-            zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
-         END DO
-      END DO
+      DO_2D_11_11
+         zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
+         taum  (ji,jj) = zztmp * wndm  (ji,jj)
+         zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
+         zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
+      END_2D
 
       !                          ! add the HF tau contribution to the wind stress module
@@ -491,12 +485,10 @@
       !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
       !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
-      DO jj = 1, jpjm1
-         DO ji = 1, fs_jpim1
-            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
-            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
-         END DO
-      END DO
+      DO_2D_10_10
+         utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+            &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+         vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+            &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
+      END_2D
       CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
 
@@ -633,18 +625,16 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      DO_2D_11_11
+         !
+         ztmp = rt0 / ptak(ji,jj)
+         !
+         ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
+         ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
+            &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
+            &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
             !
-            ztmp = rt0 / ptak(ji,jj)
-            !
-            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
-            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
-               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
-               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
-               !
-            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
-            !
-         END DO
-      END DO
+         q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
+         !
+      END_2D
       !
    END FUNCTION q_sat
@@ -669,11 +659,9 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
-            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
-            gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) )
-         END DO
-      END DO
+      DO_2D_11_11
+         zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
+         ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
+         gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) )
+      END_2D
       !
    END FUNCTION gamma_moist
@@ -735,11 +723,9 @@
       ! ------------------------------------------------------------ !
       ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-            zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
-            wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+         zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+         wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1. )
       !
@@ -763,21 +749,17 @@
       ! ------------------------------------------------------------ !
       zztmp1 = rn_vfac * 0.5_wp
-      DO jj = 2, jpj    ! at T point
-         DO ji = 2, jpi
-            zztmp2 = zrhoa(ji,jj) * Cd_atm(ji,jj) * wndm_ice(ji,jj)
-            utau_ice(ji,jj) = zztmp2 * ( sf(jp_wndi)%fnow(ji,jj,1) - zztmp1 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) ) )
-            vtau_ice(ji,jj) = zztmp2 * ( sf(jp_wndj)%fnow(ji,jj,1) - zztmp1 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) ) )
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1  ! U & V-points (same as ocean).
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
-            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
-            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
-            utau_ice(ji,jj) = zztmp1 * ( utau_ice(ji,jj) + utau_ice(ji+1,jj  ) )
-            vtau_ice(ji,jj) = zztmp2 * ( vtau_ice(ji,jj) + vtau_ice(ji  ,jj+1) )
-         END DO
-      END DO
+      DO_2D_01_01
+         zztmp2 = zrhoa(ji,jj) * Cd_atm(ji,jj) * wndm_ice(ji,jj)
+         utau_ice(ji,jj) = zztmp2 * ( sf(jp_wndi)%fnow(ji,jj,1) - zztmp1 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) ) )
+         vtau_ice(ji,jj) = zztmp2 * ( sf(jp_wndj)%fnow(ji,jj,1) - zztmp1 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) ) )
+      END_2D
+      !
+      DO_2D_00_00
+         ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
+         zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
+         zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
+         utau_ice(ji,jj) = zztmp1 * ( utau_ice(ji,jj) + utau_ice(ji+1,jj  ) )
+         vtau_ice(ji,jj) = zztmp2 * ( vtau_ice(ji,jj) + vtau_ice(ji  ,jj+1) )
+      END_2D
       CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
       !
@@ -1025,10 +1007,8 @@
          !   
          DO jl = 1, jpl                
-            DO jj = 1 , jpj
-               DO ji = 1, jpi
-                  zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
-                  IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
-               END DO
-            END DO
+            DO_2D_11_11
+               zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
+               IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
+            END_2D
          END DO
          !      
@@ -1042,30 +1022,28 @@
       !
       DO jl = 1, jpl
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-               !                    
-               zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
-                  &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
-               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
-               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
-               zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
-               !
-               DO iter = 1, nit     ! --- Iterative loop
-                  zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
-                  zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
-                  ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
-               END DO
-               !
-               ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
-               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
-               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
-               qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
-                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
-
-               ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
-               hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
-
+         DO_2D_11_11
+            !                    
+            zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
+               &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
+            ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
+            ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
+            zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
+            !
+            DO iter = 1, nit     ! --- Iterative loop
+               zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
+               zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
+               ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
             END DO
-         END DO
+            !
+            ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
+            qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
+            qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
+            qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
+                          &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
+
+            ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
+            hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
+
+         END_2D
          !
       END DO 
@@ -1195,49 +1173,47 @@
       zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg]
       !
-      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility
-         DO ji = fs_2, fs_jpim1
-            ! Virtual potential temperature [K]
-            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
-            zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
-            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
-            
-            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
-            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
-            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
-            
-            ! Momentum and Heat Neutral Transfert Coefficients
-            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
-            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
-                       
-            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
-            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
-            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
-            IF( zrib_o <= 0._wp ) THEN
-               zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10
-               zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
-                  &             )**zgamma )**z1_gamma
-            ELSE
-               zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
-               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
-            ENDIF
-            
-            IF( zrib_i <= 0._wp ) THEN
-               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
-               zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
-            ELSE
-               zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
-               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
-            ENDIF
-            
-            ! Momentum Transfert Coefficients (Eq. 38)
-            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
-               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
-            
-            ! Heat Transfert Coefficients (Eq. 49)
-            Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
-               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
-            !
-         END DO
-      END DO
+      DO_2D_00_00
+         ! Virtual potential temperature [K]
+         zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
+         zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
+         zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
+         
+         ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
+         zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
+         zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
+         
+         ! Momentum and Heat Neutral Transfert Coefficients
+         zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
+         zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
+                    
+         ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
+         z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
+         z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
+         IF( zrib_o <= 0._wp ) THEN
+            zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10
+            zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
+               &             )**zgamma )**z1_gamma
+         ELSE
+            zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
+            zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
+         ENDIF
+         
+         IF( zrib_i <= 0._wp ) THEN
+            zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
+            zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
+         ELSE
+            zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
+            zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
+         ENDIF
+         
+         ! Momentum Transfert Coefficients (Eq. 38)
+         Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
+            &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+         
+         ! Heat Transfert Coefficients (Eq. 49)
+         Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
+            &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+         !
+      END_2D
       CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. )
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90	(revision 13469)
@@ -214,22 +214,20 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zw  = pw10(ji,jj)
-            zw6 = zw*zw*zw
-            zw6 = zw6*zw6
-            !
-            ! When wind speed > 33 m/s => Cyclone conditions => special treatment
-            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1
-            !
-            CD_N10_NCAR(ji,jj) = 1.e-3_wp * ( &
-               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s
-               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s
-            !
-            CD_N10_NCAR(ji,jj) = MAX( CD_N10_NCAR(ji,jj), 0.1E-3_wp )
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zw  = pw10(ji,jj)
+         zw6 = zw*zw*zw
+         zw6 = zw6*zw6
+         !
+         ! When wind speed > 33 m/s => Cyclone conditions => special treatment
+         zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1
+         !
+         CD_N10_NCAR(ji,jj) = 1.e-3_wp * ( &
+            &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s
+            &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s
+         !
+         CD_N10_NCAR(ji,jj) = MAX( CD_N10_NCAR(ji,jj), 0.1E-3_wp )
+         !
+      END_2D
       !
    END FUNCTION CD_N10_NCAR
@@ -281,25 +279,23 @@
       REAL(wp) :: zzeta, zx2, zx, zpsi_unst, zpsi_stab,  zstab   ! local scalars
       !!----------------------------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-
-            zzeta = pzeta(ji,jj)
-            !
-            zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 - 16z)^0.5
-            zx2 = MAX( zx2 , 1._wp )
-            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25
-            zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   &
-               &            + LOG( (1._wp + zx2)*0.5_wp )   &
-               &          - 2._wp*ATAN(zx) + rpi*0.5_wp
-            !
-            zpsi_stab = -5._wp*zzeta
-            !
-            zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1
-            !
-            psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable
-               &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+
+         zzeta = pzeta(ji,jj)
+         !
+         zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 - 16z)^0.5
+         zx2 = MAX( zx2 , 1._wp )
+         zx  = SQRT(zx2)                          ! (1 - 16z)^0.25
+         zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   &
+            &            + LOG( (1._wp + zx2)*0.5_wp )   &
+            &          - 2._wp*ATAN(zx) + rpi*0.5_wp
+         !
+         zpsi_stab = -5._wp*zzeta
+         !
+         zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1
+         !
+         psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable
+            &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable
+         !
+      END_2D
    END FUNCTION psi_m_ncar
 
@@ -322,22 +318,20 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zzeta = pzeta(ji,jj)
-            !
-            zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 -16z)^0.5
-            zx2 = MAX( zx2 , 1._wp )
-            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) )
-            !
-            zpsi_stab = -5._wp*zzeta
-            !
-            zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1
-            !
-            psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable
-               &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zzeta = pzeta(ji,jj)
+         !
+         zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 -16z)^0.5
+         zx2 = MAX( zx2 , 1._wp )
+         zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) )
+         !
+         zpsi_stab = -5._wp*zzeta
+         !
+         zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1
+         !
+         psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable
+            &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable
+         !
+      END_2D
    END FUNCTION psi_h_ncar
 
@@ -382,19 +376,17 @@
       !!-------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zqa = (1._wp + rctv0*pqa(ji,jj))
-            !
-            ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with:
-            !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one!
-            !                      or
-            !  b/  -u* [ theta*              + 0.61 theta q* ]
-            !
-            One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) &
-               &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp )
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zqa = (1._wp + rctv0*pqa(ji,jj))
+         !
+         ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with:
+         !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one!
+         !                      or
+         !  b/  -u* [ theta*              + 0.61 theta q* ]
+         !
+         One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) &
+            &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp )
+         !
+      END_2D
       !
       One_on_L = SIGN( MIN(ABS(One_on_L),200._wp), One_on_L ) ! (prevent FPE from stupid values over masked regions...)
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90	(revision 13469)
@@ -1193,10 +1193,8 @@
             !                              
             IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
-               DO jj = 2, jpjm1                                          ! T ==> (U,V)
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
-                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
-                  END DO
-               END DO
+               DO_2D_00_00
+                  frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
+                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1., frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. )
             ENDIF
@@ -1219,11 +1217,9 @@
          ! => need to be done only when otx1 was changed
          IF( llnewtx ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vect. opt.
-                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
-                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
-                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
-               END DO
-            END DO
+            DO_2D_00_00
+               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
+               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
+               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+            END_2D
             CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
             llnewtau = .TRUE.
@@ -1246,9 +1242,7 @@
          IF( llnewtau ) THEN 
             zcoef = 1. / ( zrhoa * zcdrag ) 
-            DO jj = 1, jpj
-               DO ji = 1, jpi 
-                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
-               END DO
-            END DO
+            DO_2D_11_11
+               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+            END_2D
          ENDIF
       ENDIF
@@ -1389,12 +1383,12 @@
       IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
          ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
-         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         uu (:,:,1,Nnn) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
+         uu (:,:,1,Nii) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssu_m', ssu_m )
       ENDIF
       IF( srcv(jpr_ocy1)%laction ) THEN
          ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
-         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         vv (:,:,1,Nnn) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
+         vv (:,:,1,Nii) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssv_m', ssv_m )
       ENDIF
@@ -1586,13 +1580,11 @@
             p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
          CASE( 'T' )
-            DO jj = 2, jpjm1                                   ! T ==> (U,V)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
-                  zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
-                  zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
-                  p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
-                  p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
+               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
+               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
+               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
+               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
+            END_2D
             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
          END SELECT
@@ -2466,34 +2458,28 @@
          !                                                               i      i+1 (for I)
          IF( nn_components == jp_iam_opa ) THEN
-            zotx1(:,:) = un(:,:,1)  
-            zoty1(:,:) = vn(:,:,1)  
+            zotx1(:,:) = uu(:,:,1,Nii)  
+            zoty1(:,:) = vv(:,:,1,Nii)  
          ELSE        
             SELECT CASE( TRIM( sn_snd_crt%cldes ) )
             CASE( 'oce only'             )      ! C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
-                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) )
+                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji  ,jj-1,1,Nii) ) 
+               END_2D
             CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T  
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
-                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)  
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj)
+                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
             CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+               END_2D
             END SELECT
             CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.,  zoty1, ssnd(jps_ocy1)%clgrid, -1. )
@@ -2554,29 +2540,23 @@
           SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
           CASE( 'oce only'             )      ! C-grid ==> T 
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
-                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )  
-                END DO 
-             END DO 
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) ) 
+                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji , jj-1,1,Nii) )  
+             END_2D
           CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
-                   zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj) 
+                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. ) 
           CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T  
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
           END SELECT
          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90	(revision 13469)
@@ -115,27 +115,23 @@
       !
       IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U|
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               imk = k_mk(ji,jj)          ! ocean bottom level at t-points
-               zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point
-               zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk)
-               zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary
-               !
+         DO_2D_00_00
+            imk = k_mk(ji,jj)          ! ocean bottom level at t-points
+            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point
+            zvt = vv(ji,jj,imk,Nii) + vv(ji,jj-1,imk,Nii)
+            zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary
+            !
 !!JC: possible WAD implementation should modify line below if layers vanish
-               zcd = (  vkarmn / LOG( zzz / pz0 )  )**2
-               zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost
-               pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
-            END DO
-         END DO
+            zcd = (  vkarmn / LOG( zzz / pz0 )  )**2
+            zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost
+            pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
+         END_2D
       ELSE                                            !==  standard Cd  ==!
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               imk = k_mk(ji,jj)    ! ocean bottom level at t-points
-               zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point
-               zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk)
-               !                                                           ! here pCd0 = mask*boost * drag
-               pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
-            END DO
-         END DO
+         DO_2D_00_00
+            imk = k_mk(ji,jj)    ! ocean bottom level at t-points
+            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point
+            zvt = vv(ji,jj,imk,Nii) + vv(ji,jj-1,imk,Nii)
+            !                                                           ! here pCd0 = mask*boost * drag
+            pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
+         END_2D
       ENDIF
       !
@@ -177,32 +173,28 @@
       ENDIF
 
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
-            ikbv = mbkv(ji,jj)
+      DO_2D_00_00
+         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
+         ikbv = mbkv(ji,jj)
+         !
+         ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+         zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)
+         zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)
+         !
+         pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
+         pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
+      END_2D
+      !
+      IF( ln_isfcav ) THEN        ! ocean cavities
+         DO_2D_00_00
+            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+            ikbv = mikv(ji,jj)
             !
             ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-            zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)
-            zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)
+            zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked
+            zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv)
             !
             pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
             pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
-         END DO
-      END DO
-      !
-      IF( ln_isfcav ) THEN        ! ocean cavities
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
-               ikbv = mikv(ji,jj)
-               !
-               ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-               zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked
-               zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv)
-               !
-               pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
-               pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
-           END DO
-         END DO
+         END_2D
       ENDIF
       !
@@ -442,11 +434,9 @@
             l_log_not_linssh = .FALSE.    !- don't update Cd at each time step
             !
-            DO jj = 1, jpj                   ! pCd0 = mask (and boosted) logarithmic drag coef. 
-               DO ji = 1, jpi
-                  zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj))
-                  zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2
-                  pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax
-               END DO
-            END DO
+            DO_2D_11_11
+               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj))
+               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2
+               pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax
+            END_2D
          ELSE                       !* Cd updated at each time-step ==> pCd0 = mask * boost
             IF(lwp) WRITE(numout,*)
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfgls.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfgls.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfgls.F90	(revision 13469)
@@ -177,30 +177,24 @@
       
       ! Compute surface, top and bottom friction at T-points
-      DO jj = 2, jpjm1              !==  surface ocean friction
-         DO ji = fs_2, fs_jpim1           ! vector opt.         
-            ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
+      END_2D
       !   
 !!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that...
       !    
       IF( .NOT.ln_drg_OFF ) THEN    !== top/bottom friction   (explicit before friction)
-         DO jj = 2, jpjm1                      ! bottom friction
-            DO ji = fs_2, fs_jpim1   ! vector opt.         
-               zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
-               zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
-               ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
-                  &                                         + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
-            END DO
-         END DO
+         DO_2D_00_00
+            zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+            zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
+            ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Nnn)+uu(ji-1,jj,mbkt(ji,jj),Nnn) ) )**2  &
+               &                                         + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Nnn)+vv(ji,jj-1,mbkt(ji,jj),Nnn) ) )**2  )
+         END_2D
          IF( ln_isfcav ) THEN       !top friction
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmsku = ( 2._wp - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
-                  zmskv = ( 2._wp - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0)
-                  ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
-                     &                                         + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
-               END DO
-            END DO
+            DO_2D_00_00
+               zmsku = ( 2._wp - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
+               zmskv = ( 2._wp - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0)
+               ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Nnn)+uu(ji-1,jj,mikt(ji,jj),Nnn) ) )**2  &
+                  &                                         + ( zmskv*( vv(ji,jj,mikt(ji,jj),Nnn)+vv(ji,jj-1,mikt(ji,jj),Nnn) ) )**2  )
+            END_2D
          ENDIF
       ENDIF
@@ -224,11 +218,7 @@
       zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro
       !
-      DO jk = 2, jpkm1              !==  Compute dissipation rate  ==!
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_10_10( 2, jpkm1 )
+         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
+      END_3D
 
       ! Save tke at before time step
@@ -237,14 +227,10 @@
 
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
-                  zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
-                  zcoef = ( zup / MAX( zdown, rsmall ) )
-                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
+            zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
+            zcoef = ( zup / MAX( zdown, rsmall ) )
+            zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
+         END_3D
       ENDIF
 
@@ -262,46 +248,42 @@
       ! Warning : after this step, en : right hand side of the matrix
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               !
-               buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
-               !
-               diss = eps(ji,jj,jk)                         ! dissipation
-               !
-               zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
-               !
-               zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term
-               zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+      DO_3D_00_00( 2, jpkm1 )
+         !
+         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
+         !
+         diss = eps(ji,jj,jk)                         ! dissipation
+         !
+         zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+         !
+         zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term
+         zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
 !!gm better coding, identical results
 !               zesh2 =   p_sh2(ji,jj,jk) + zdir*buoy               ! production term
 !               zdiss = ( diss - (1._wp-zdir)*buoy ) / en(ji,jj,jk) ! dissipation term
 !!gm
-               !
-               ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
-               ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
-               ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
-               ! Otherwise, this should be rsc_psi/rsc_psi0
-               IF( ln_sigpsi ) THEN
-                  zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
-                  zwall_psi(ji,jj,jk) = rsc_psi /   & 
-                     &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
-               ELSE
-                  zwall_psi(ji,jj,jk) = 1._wp
-               ENDIF
-               !
-               ! building the matrix
-               zcof = rfact_tke * tmask(ji,jj,jk)
-               !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions)
-               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
-               !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions)
-               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
-               !                                        ! diagonal
-               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk) 
-               !                                        ! right hand side in en
-               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+         !
+         ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
+         ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
+         ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
+         ! Otherwise, this should be rsc_psi/rsc_psi0
+         IF( ln_sigpsi ) THEN
+            zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
+            zwall_psi(ji,jj,jk) = rsc_psi /   & 
+               &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
+         ELSE
+            zwall_psi(ji,jj,jk) = 1._wp
+         ENDIF
+         !
+         ! building the matrix
+         zcof = rfact_tke * tmask(ji,jj,jk)
+         !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions)
+         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
+         !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions)
+         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+         !                                        ! diagonal
+         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk) 
+         !                                        ! right hand side in en
+         en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
+      END_3D
       !
       zdiag(:,:,jpk) = 1._wp
@@ -360,75 +342,67 @@
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+         DO_2D_00_00
 !!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ????
 !!   With thick deep ocean level thickness, this may be quite large, no ???
 !!   in particular in ocean cavities where top stratification can be large...
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+            !
+            ! Dirichlet condition applied at: 
+            !     Bottom level (ibot)      &      Just above it (ibotm1)   
+            zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp
+            en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en
+         END_2D
+         !
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO_2D_00_00
+               itop   = mikt(ji,jj)       ! k   top w-point
+               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+               !                                                ! mask at the ocean surface points
+               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
                !
-               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
-               !
+ !!gm TO BE VERIFIED !!!
                ! Dirichlet condition applied at: 
-               !     Bottom level (ibot)      &      Just above it (ibotm1)   
-               zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp
-               en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en
-            END DO
-         END DO
-         !
-         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  itop   = mikt(ji,jj)       ! k   top w-point
-                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
-                  !                                                ! mask at the ocean surface points
-                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
-                  !
- !!gm TO BE VERIFIED !!!
-                  ! Dirichlet condition applied at: 
-                  !     top level (itop)         &      Just below it (itopp1)   
-                  zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp
-                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
-                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp
-                  en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en
-               END DO
-            END DO
+               !     top level (itop)         &      Just below it (itopp1)   
+               zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp
+               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp
+               en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en
+            END_2D
          ENDIF
          !
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               !
-               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+            !
+            ! Bottom level Dirichlet condition:
+            !     Bottom level (ibot)      &      Just above it (ibotm1)   
+            !         Dirichlet            !         Neumann
+            zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag
+            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1)
+            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+         END_2D
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO_2D_00_00
+               itop   = mikt(ji,jj)       ! k   top w-point
+               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+               !                                                ! mask at the ocean surface points
+               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
                !
                ! Bottom level Dirichlet condition:
                !     Bottom level (ibot)      &      Just above it (ibotm1)   
                !         Dirichlet            !         Neumann
-               zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag
-               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1)
-               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
-            END DO
-         END DO
-         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  itop   = mikt(ji,jj)       ! k   top w-point
-                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
-                  !                                                ! mask at the ocean surface points
-                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
-                  !
-                  ! Bottom level Dirichlet condition:
-                  !     Bottom level (ibot)      &      Just above it (ibotm1)   
-                  !         Dirichlet            !         Neumann
-                  zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag
-                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1)
-                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
-               END DO
-            END DO
+               zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag
+               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1)
+               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+            END_2D
          ENDIF
          !
@@ -438,25 +412,13 @@
       ! ----------------------------------------------------------
       !
-      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( 2, jpk )
+         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( jpk-1, 2, -1 )
+         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
       !                                            ! set the minimum value of tke 
       en(:,:,:) = MAX( en(:,:,:), rn_emin )
@@ -471,38 +433,22 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
+         END_3D
          !
       CASE( 1 )               ! k-eps
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = eps(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = eps(ji,jj,jk)
+         END_3D
          !
       CASE( 2 )               ! k-w
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
+         END_3D
          !
       CASE( 3 )               ! generic
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
+         END_3D
          !
       END SELECT
@@ -515,43 +461,39 @@
       ! Warning : after this step, en : right hand side of the matrix
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !
-               ! psi / k
-               zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
-               !
-               ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable)
-               zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
-               !
-               rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p
-               !
-               ! shear prod. - stratif. destruction
-               prod = rpsi1 * zratio * p_sh2(ji,jj,jk)
-               !
-               ! stratif. destruction
-               buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) )
-               !
-               ! shear prod. - stratif. destruction
-               diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
-               !
-               zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
-               !
-               zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term
-               zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
-               !                                                        
-               ! building the matrix
-               zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
-               !                                               ! lower diagonal
-               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
-               !                                               ! upper diagonal
-               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
-               !                                               ! diagonal
-               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)
-               !                                               ! right hand side in psi
-               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         !
+         ! psi / k
+         zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
+         !
+         ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable)
+         zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
+         !
+         rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p
+         !
+         ! shear prod. - stratif. destruction
+         prod = rpsi1 * zratio * p_sh2(ji,jj,jk)
+         !
+         ! stratif. destruction
+         buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) )
+         !
+         ! shear prod. - stratif. destruction
+         diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
+         !
+         zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+         !
+         zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term
+         zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
+         !                                                        
+         ! building the matrix
+         zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
+         !                                               ! lower diagonal
+         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
+         !                                               ! upper diagonal
+         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+         !                                               ! diagonal
+         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)
+         !                                               ! right hand side in psi
+         psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
+      END_3D
       !
       zdiag(:,:,jpk) = 1._wp
@@ -615,49 +557,45 @@
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot
          !                      ! Balance between the production and the dissipation terms
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               zdep(ji,jj) = vkarmn * r_z0_bot
-               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
-               zd_lw(ji,jj,ibot) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp
-               !
-               ! Just above last level, Dirichlet condition again (GOTM like)
-               zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) )
-               psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
-               zd_lw(ji,jj,ibotm1) = 0._wp
-               zd_up(ji,jj,ibotm1) = 0._wp
-               zdiag(ji,jj,ibotm1) = 1._wp
-            END DO
-         END DO
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            zdep(ji,jj) = vkarmn * r_z0_bot
+            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+            zd_lw(ji,jj,ibot) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp
+            !
+            ! Just above last level, Dirichlet condition again (GOTM like)
+            zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) )
+            psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
+            zd_lw(ji,jj,ibotm1) = 0._wp
+            zd_up(ji,jj,ibotm1) = 0._wp
+            zdiag(ji,jj,ibotm1) = 1._wp
+         END_2D
          !
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               !
-               ! Bottom level Dirichlet condition:
-               zdep(ji,jj) = vkarmn * r_z0_bot
-               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
-               !
-               zd_lw(ji,jj,ibot) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp
-               !
-               ! Just above last level: Neumann condition with flux injection
-               zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag
-               zd_up(ji,jj,ibotm1) = 0.
-               !
-               ! Set psi vertical flux at the bottom:
-               zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1)
-               zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   &
-                  &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
-               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1)
-            END DO
-         END DO
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            ! Bottom level Dirichlet condition:
+            zdep(ji,jj) = vkarmn * r_z0_bot
+            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+            !
+            zd_lw(ji,jj,ibot) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp
+            !
+            ! Just above last level: Neumann condition with flux injection
+            zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag
+            zd_up(ji,jj,ibotm1) = 0.
+            !
+            ! Set psi vertical flux at the bottom:
+            zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1)
+            zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   &
+               &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
+            psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1)
+         END_2D
          !
       END SELECT
@@ -666,25 +604,13 @@
       ! ----------------
       !
-      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( 2, jpk )
+         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( jpk-1, 2, -1 )
+         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
 
       ! Set dissipation
@@ -694,29 +620,17 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
+         END_3D
          !
       CASE( 1 )               ! k-eps
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = psi(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = psi(ji,jj,jk)
+         END_3D
          !
       CASE( 2 )               ! k-w
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+         END_3D
          !
       CASE( 3 )               ! generic
@@ -724,11 +638,7 @@
          zex1  =      ( 1.5_wp + rmm/rnn )
          zex2  = -1._wp / rnn
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
+         END_3D
          !
       END SELECT
@@ -736,16 +646,12 @@
       ! Limit dissipation rate under stable stratification
       ! --------------------------------------------------
-      DO jk = 1, jpkm1 ! Note that this set boundary conditions on hmxl_n at the same time
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               ! limitation
-               eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
-               hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
-               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
-               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
-            END DO
-         END DO
-      END DO 
+      DO_3D_00_00( 1, jpkm1 )
+         ! limitation
+         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
+         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+         ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
+         zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+         IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
+      END_3D
 
       !
@@ -756,51 +662,43 @@
       !
       CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! zcof =  l²/q²
-                  zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
-                  ! Gh = -N²l²/q²
-                  gh = - rn2(ji,jj,jk) * zcof
-                  gh = MIN( gh, rgh0   )
-                  gh = MAX( gh, rghmin )
-                  ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
-                  sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
-                  sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
-                  !
-                  ! Store stability function in zstt and zstm
-                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
-                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ! zcof =  l²/q²
+            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
+            ! Gh = -N²l²/q²
+            gh = - rn2(ji,jj,jk) * zcof
+            gh = MIN( gh, rgh0   )
+            gh = MAX( gh, rghmin )
+            ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
+            sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
+            sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
+            !
+            ! Store stability function in zstt and zstm
+            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+         END_3D
          !
       CASE ( 2, 3 )               ! Canuto stability functions
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! zcof =  l²/q²
-                  zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
-                  ! Gh = -N²l²/q²
-                  gh = - rn2(ji,jj,jk) * zcof
-                  gh = MIN( gh, rgh0   )
-                  gh = MAX( gh, rghmin )
-                  gh = gh * rf6
-                  ! Gm =  M²l²/q² Shear number
-                  shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall )
-                  gm = MAX( shr * zcof , 1.e-10 )
-                  gm = gm * rf6
-                  gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
-                  ! Stability functions from Canuto
-                  rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
-                  sm = (rs0 - rs1*gh + rs2*gm) / rcff
-                  sh = (rs4 - rs5*gh + rs6*gm) / rcff
-                  !
-                  ! Store stability function in zstt and zstm
-                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
-                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ! zcof =  l²/q²
+            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
+            ! Gh = -N²l²/q²
+            gh = - rn2(ji,jj,jk) * zcof
+            gh = MIN( gh, rgh0   )
+            gh = MAX( gh, rghmin )
+            gh = gh * rf6
+            ! Gm =  M²l²/q² Shear number
+            shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall )
+            gm = MAX( shr * zcof , 1.e-10 )
+            gm = gm * rf6
+            gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
+            ! Stability functions from Canuto
+            rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
+            sm = (rs0 - rs1*gh + rs2*gm) / rcff
+            sh = (rs4 - rs5*gh + rs6*gm) / rcff
+            !
+            ! Store stability function in zstt and zstm
+            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+         END_3D
          !
       END SELECT
@@ -813,9 +711,7 @@
       ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0)
       zstm(:,:,jpk) = 0.  
-      DO jj = 2, jpjm1                ! update bottom with good values
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
-         END DO
-      END DO
+      DO_2D_00_00
+         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
+      END_2D
 
       zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
@@ -830,15 +726,11 @@
       !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk)
       !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0)
-      DO jk = 1, jpk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
-               zavt  = zsqen * zstt(ji,jj,jk)
-               zavm  = zsqen * zstm(ji,jj,jk)
-               p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
-               p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpk )
+         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
+         zavt  = zsqen * zstt(ji,jj,jk)
+         zavm  = zsqen * zstm(ji,jj,jk)
+         p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
+         p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
+      END_3D
       p_avt(:,:,1) = 0._wp
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdftke.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdftke.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdftke.F90	(revision 13469)
@@ -231,13 +231,11 @@
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !
-      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
-         DO ji = fs_2, fs_jpim1   ! vector opt.
+      DO_2D_00_00
 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly
 !!       one way around would be to increase zbbirau 
 !!          en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + &
 !!             &                                     fr_i(ji,jj)   * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1)
-            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
-         END DO
-      END DO
+         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+      END_2D
       !
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -251,26 +249,22 @@
       IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE
          !
-         DO jj = 2, jpjm1              ! bottom friction
-            DO ji = fs_2, fs_jpim1     ! vector opt.
-               zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
-               zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
-               !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
-               zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
-                  &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
-               en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
+            !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
+            zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Nnn)+uu(ji-1,jj,mbkt(ji,jj),Nnn) ) )**2  &
+               &                                           + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Nnn)+vv(ji,jj-1,mbkt(ji,jj),Nnn) ) )**2  )
+            en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
+         END_2D
          IF( ln_isfcav ) THEN       ! top friction
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
-                  zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
-                  !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0)
-                  zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
-                     &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
-                  en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) &     
-                     &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
+               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
+               !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0)
+               zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Nnn)+uu(ji-1,jj,mikt(ji,jj),Nnn) ) )**2  &
+                  &                                           + ( zmskv*( vv(ji,jj,mikt(ji,jj),Nnn)+vv(ji,jj-1,mikt(ji,jj),Nnn) ) )**2  )
+               en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) &     
+                  &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj)
+            END_2D
          ENDIF
          !
@@ -289,40 +283,28 @@
          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
-         DO jk = jpkm1, 2, -1
-            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us 
-               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1)
-                  zus  = zcof * taum(ji,jj)
-                  IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( jpkm1, 2, -1 )
+            zus  = zcof * taum(ji,jj)
+            IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
+         END_3D
          !                               ! finite LC depth
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj))
-            END DO
-         END DO
+         DO_2D_11_11
+            zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj))
+         END_2D
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
-               zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
-            END DO
-         END DO         
-         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF ( zus3(ji,jj) /= 0._wp ) THEN               
-                     ! vertical velocity due to LC   
-                     IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
-                        !                                           ! vertical velocity due to LC
-                        zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )
-                        !                                           ! TKE Langmuir circulation source term
-                        en(ji,jj,jk) = en(ji,jj,jk) + rdt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
+            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
+         END_2D
+         DO_3D_00_00( 2, jpkm1 )
+            IF ( zus3(ji,jj) /= 0._wp ) THEN               
+               ! vertical velocity due to LC   
+               IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
+                  !                                           ! vertical velocity due to LC
+                  zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )
+                  !                                           ! TKE Langmuir circulation source term
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)
+               ENDIF
+            ENDIF
+         END_3D
          !
       ENDIF
@@ -336,78 +318,50 @@
       !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri )
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !                             ! local Richardson number
-                  zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
-                  !                             ! inverse of Prandtl number
-                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            !                             ! local Richardson number
+            zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
+            !                             ! inverse of Prandtl number
+            apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+         END_3D
       ENDIF
       !         
-      DO jk = 2, jpkm1           !* Matrix and right hand side in en
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcof   = zfact1 * tmask(ji,jj,jk)
-               !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
-               !                                   ! eddy coefficient (ensure numerical stability)
-               zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal
-                  &          /    (  p_e3t(ji,jj,jk  ) * p_e3w(ji,jj,jk  )  )
-               zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal
-                  &          /    (  p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk  )  )
-               !
-               zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
-               zd_lw(ji,jj,jk) = zzd_lw
-               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk)
-               !
-               !                                   ! right hand side in en
-               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear
-                  &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification
-                  &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation
-                  &                                ) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zcof   = zfact1 * tmask(ji,jj,jk)
+         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
+         !                                   ! eddy coefficient (ensure numerical stability)
+         zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal
+            &          /    (  p_e3t(ji,jj,jk  ) * p_e3w(ji,jj,jk  )  )
+         zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal
+            &          /    (  p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk  )  )
+         !
+         zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
+         zd_lw(ji,jj,jk) = zzd_lw
+         zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk)
+         !
+         !                                   ! right hand side in en
+         en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear
+            &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification
+            &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation
+            &                                ) * wmask(ji,jj,jk)
+      END_3D
       !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
-      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
-         END DO
-      END DO
-      DO jk = 3, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 2, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpkm1                             ! set the minimum value of tke
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 3, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_2D_00_00
+         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+      END_2D
+      DO_3D_00_00( 3, jpkm1 )
+         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_2D_00_00
+         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
+      END_2D
+      DO_3D_00_00( jpk-2, 2, -1 )
+         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
+      DO_3D_00_00( 2, jpkm1 )
+         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
+      END_3D
       !
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -419,34 +373,24 @@
       
       IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
-         DO jk = 2, jpkm1                       ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
+               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_3D
       ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               jk = nmln(ji,jj)
-               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                  &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            jk = nmln(ji,jj)
+            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
+               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_2D
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
-                  zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
-                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
-                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
-                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
+            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
+            ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
+            zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
+            zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
+            en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
+               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_3D
       ENDIF
       !
@@ -515,9 +459,7 @@
          zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
 #if ! defined key_si3 && ! defined key_cice
-         DO jj = 2, jpjm1                     ! No sea-ice
-            DO ji = fs_2, fs_jpim1
-               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1)
+         END_2D
 #else
 
@@ -525,49 +467,39 @@
          !
          CASE( 0 )                      ! No scaling under sea-ice
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)
+            END_2D
             !
          CASE( 1 )                      ! scaling with constant sea-ice thickness
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
-                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
+                  &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1)
+            END_2D
             !
          CASE( 2 )                      ! scaling with mean sea-ice thickness
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
+            DO_2D_00_00
 #if defined key_si3
-                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
-                     &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1)
+               zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
+                  &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1)
 #elif defined key_cice
-                  zmaxice = MAXVAL( h_i(ji,jj,:) )
-                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
-                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1)
+               zmaxice = MAXVAL( h_i(ji,jj,:) )
+               zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
+                  &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1)
 #endif
-               END DO
-            END DO
+            END_2D
             !
          CASE( 3 )                      ! scaling with max sea-ice thickness
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zmaxice = MAXVAL( h_i(ji,jj,:) )
-                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
-                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               zmaxice = MAXVAL( h_i(ji,jj,:) )
+               zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
+                  &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1)
+            END_2D
             !
          END SELECT
 #endif
          !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) )
+         END_2D
          !
       ELSE
@@ -575,12 +507,8 @@
       ENDIF
       !
-      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
+      END_3D
       !
       !                     !* Physical limits for the mixing length
@@ -594,70 +522,42 @@
       ! where wmask = 0 set zmxlm == p_e3w
       CASE ( 0 )           ! bounded by the distance to surface and bottom
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
-                  &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) )
-                  ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
-                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
-                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
+            &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) )
+            ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
+            zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
+            zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
+         END_3D
          !
       CASE ( 1 )           ! bounded by the vertical scale factor
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) )
+            zmxlm(ji,jj,jk) = zemxl
+            zmxld(ji,jj,jk) = zemxl
+         END_3D
          !
       CASE ( 2 )           ! |dk[xml]| bounded by e3t :
-         DO jk = 2, jpkm1         ! from the surface to the bottom :
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3D_00_00( jpkm1, 2, -1 )
+            zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+            zmxlm(ji,jj,jk) = zemxl
+            zmxld(ji,jj,jk) = zemxl
+         END_3D
          !
       CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
-         DO jk = 2, jpkm1         ! from the surface to the bottom : lup
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
-                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemlm
-                  zmxld(ji,jj,jk) = zemlp
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3D_00_00( jpkm1, 2, -1 )
+            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3D_00_00( 2, jpkm1 )
+            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
+            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
+            zmxlm(ji,jj,jk) = zemlm
+            zmxld(ji,jj,jk) = zemlp
+         END_3D
          !
       END SELECT
@@ -666,25 +566,17 @@
       !                     !  Vertical eddy viscosity and diffusivity  (avm and avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zsqen = SQRT( en(ji,jj,jk) )
-               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
-               p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
-               p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
-               dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zsqen = SQRT( en(ji,jj,jk) )
+         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
+         p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
+         p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+         dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
+      END_3D
       !
       !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
-              END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+         END_3D
       ENDIF
       !
Index: /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zfechem.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zfechem.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zfechem.F90	(revision 13469)
@@ -89,86 +89,78 @@
       ! Chemistry is supposed to be fast enough to be at equilibrium
       ! ------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk)
-               zkeq            = fekeq(ji,jj,jk)
-               zfesatur        = zTL1(ji,jj,jk) * 1E-9
-               ztfe            = trb(ji,jj,jk,jpfer) 
-               ! Fe' is the root of a 2nd order polynom
-               zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
-                  &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       &
-                  &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
-               zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
-               zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
-           END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk)
+         zkeq            = fekeq(ji,jj,jk)
+         zfesatur        = zTL1(ji,jj,jk) * 1E-9
+         ztfe            = trb(ji,jj,jk,jpfer) 
+         ! Fe' is the root of a 2nd order polynom
+         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
+            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       &
+            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
+         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
+         zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
+      END_3D
          !
 
       zdust = 0.         ! if no dust available
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
-               ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
-               ! Scavenging onto dust is also included as evidenced from the DUNE experiments.
-               ! --------------------------------------------------------------------------------------
-               zhplus  = max( rtrn, hi(ji,jj,jk) )
-               fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
-               &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
-               &         + fesol(ji,jj,jk,5) / zhplus )
-               !
-               zfeequi = zFe3(ji,jj,jk) * 1E-9
-               zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
-               ! precipitation of Fe3+, creation of nanoparticles
-               precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep
-               !
-               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
-               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) &
-               &  * EXP( -gdept_n(ji,jj,jk) / 540. )
-               IF (ln_ligand) THEN
-                  zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) ))
-               ELSE
-                  zxlam  = xlam1 * 1.0
-               ENDIF
-               zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc
-               zscave = zfeequi * zlam1b * xstep
-
-               ! Compute the different ratios for scavenging of iron
-               ! to later allocate scavenged iron to the different organic pools
-               ! ---------------------------------------------------------
-               zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b
-               zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b
-
-               !  Increased scavenging for very high iron concentrations found near the coasts 
-               !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...)
-               !  -----------------------------------------------------------
-               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
-               zlamfac = MIN( 1.  , zlamfac )
-               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
-               zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer)
-
-               !  Compute the coagulation of colloidal iron. This parameterization 
-               !  could be thought as an equivalent of colloidal pumping.
-               !  It requires certainly some more work as it is very poorly constrained.
-               !  ----------------------------------------------------------------
-               zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                   &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
-               zaggdfea = zlam1a * xstep * zfecoll
-               !
-               zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
-               zaggdfeb = zlam1b * xstep * zfecoll
-               !
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb &
-               &                     - zcoag - precip(ji,jj,jk)
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb
-               zscav3d(ji,jj,jk)   = zscave
-               zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb
-               !
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
+         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
+         ! Scavenging onto dust is also included as evidenced from the DUNE experiments.
+         ! --------------------------------------------------------------------------------------
+         zhplus  = max( rtrn, hi(ji,jj,jk) )
+         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
+         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
+         &         + fesol(ji,jj,jk,5) / zhplus )
+         !
+         zfeequi = zFe3(ji,jj,jk) * 1E-9
+         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
+         ! precipitation of Fe3+, creation of nanoparticles
+         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep
+         !
+         ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
+         IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) &
+         &  * EXP( -gdept_n(ji,jj,jk) / 540. )
+         IF (ln_ligand) THEN
+            zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) ))
+         ELSE
+            zxlam  = xlam1 * 1.0
+         ENDIF
+         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc
+         zscave = zfeequi * zlam1b * xstep
+
+         ! Compute the different ratios for scavenging of iron
+         ! to later allocate scavenged iron to the different organic pools
+         ! ---------------------------------------------------------
+         zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b
+         zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b
+
+         !  Increased scavenging for very high iron concentrations found near the coasts 
+         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...)
+         !  -----------------------------------------------------------
+         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
+         zlamfac = MIN( 1.  , zlamfac )
+         zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
+         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer)
+
+         !  Compute the coagulation of colloidal iron. This parameterization 
+         !  could be thought as an equivalent of colloidal pumping.
+         !  It requires certainly some more work as it is very poorly constrained.
+         !  ----------------------------------------------------------------
+         zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+             &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+         zaggdfea = zlam1a * xstep * zfecoll
+         !
+         zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+         zaggdfeb = zlam1b * xstep * zfecoll
+         !
+         tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb &
+         &                     - zcoag - precip(ji,jj,jk)
+         tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea
+         tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb
+         zscav3d(ji,jj,jk)   = zscave
+         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb
+         !
+      END_3D
       !
       !  Define the bioavailable fraction of iron
@@ -178,19 +170,15 @@
       IF( ln_ligand ) THEN
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
-                  !
-                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
-                  zligco   = 0.5 * trn(ji,jj,jk,jplgw)
-                  zaggliga = zlam1a * xstep * zligco
-                  zaggligb = zlam1b * xstep * zligco
-                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb
-                  zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+            !
+            zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+            zligco   = 0.5 * trn(ji,jj,jk,jplgw)
+            zaggliga = zlam1a * xstep * zligco
+            zaggligb = zlam1b * xstep * zligco
+            tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb
+            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb
+         END_3D
          !
          plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) )
Index: /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90	(revision 13469)
@@ -126,43 +126,39 @@
             CALL fld_read( kt, 1, sf_river )
             IF( ln_p4z ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
-                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                     rivdic(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
-                        &              * 1.E3         / ( 12. * zcoef + rtrn )
-                     rivdin(ji,jj) =   sf_river(jr_din)%fnow(ji,jj,1)  &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
-                     rivdip(ji,jj) =   sf_river(jr_dip)%fnow(ji,jj,1)  &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
-                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
-                     rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn ) 
-                  END DO
-               END DO
+               DO_2D_11_11
+                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
+                     &              * 1.E3        / ( 12. * zcoef + rtrn )
+                  rivdic(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
+                     &              * 1.E3         / ( 12. * zcoef + rtrn )
+                  rivdin(ji,jj) =   sf_river(jr_din)%fnow(ji,jj,1)  &
+                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
+                  rivdip(ji,jj) =   sf_river(jr_dip)%fnow(ji,jj,1)  &
+                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
+                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
+                     &              * 1.E3        / ( 28.1 * zcoef + rtrn )
+                  rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
+                     &              * 1.E3        / ( 12. * zcoef + rtrn ) 
+               END_2D
             ELSE    !  ln_p5z
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
-                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
-                     rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                  END DO
-               END DO
+               DO_2D_11_11
+                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
+                     &              * 1.E3        / ( 12. * zcoef + rtrn )
+                  rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
+                     &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
+                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
+                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
+                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
+                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
+                     &              * 1.E3        / ( 28.1 * zcoef + rtrn )
+                  rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
+                     &              * 1.E3        / ( 12. * zcoef + rtrn )
+               END_2D
             ENDIF
          ENDIF
@@ -411,33 +407,25 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
-         DO jk = 1, ik50
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ze3t   = e3t_0(ji,jj,jk)
-                  zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   &
-                          + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   &
-                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   &
-                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) )
-                  zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
-                  ! estimation of the coastal slope : 5 km off the coast
-                  ze3t2 = ze3t * ze3t
-                  zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
-                  !
-                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, ik50 )
+            ze3t   = e3t_0(ji,jj,jk)
+            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   &
+                    + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   &
+                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   &
+                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) )
+            zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
+            ! estimation of the coastal slope : 5 km off the coast
+            ze3t2 = ze3t * ze3t
+            zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
+            !
+            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
+         END_3D
          !
          CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
          !
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
-                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
-                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpk )
+            zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
+            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
+            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
+         END_3D
          ! Coastal supply of iron
          ! -------------------------
Index: /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsms.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsms.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsms.F90	(revision 13469)
@@ -127,14 +127,10 @@
          xnegtr(:,:,:) = 1.e0
          DO jn = jp_pcs0, jp_pcs1
-            DO jk = 1, jpk
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
-                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
-                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
-                     ENDIF
-                 END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, jpk )
+               IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
+                  ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
+                  xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+               ENDIF
+            END_3D
          END DO
          !                                ! where at least 1 tracer concentration becomes negative
Index: /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/diawri.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/diawri.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/diawri.F90	(revision 13469)
@@ -150,10 +150,8 @@
       CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature
       IF ( iom_use("sbt") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem)
+         END_2D
          CALL iom_put( "sbt", z2d )                ! bottom temperature
       ENDIF
@@ -162,10 +160,8 @@
       CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity
       IF ( iom_use("sbs") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal)
+         END_2D
          CALL iom_put( "sbs", z2d )                ! bottom salinity
       ENDIF
@@ -174,39 +170,33 @@
          zztmp = rau0 * 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) ) * un(ji  ,jj,mbku(ji  ,jj))  )**2   &
-                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj))  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vn(ji,jj  ,mbkv(ji,jj  ))  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1))  )**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),Nii)  )**2   &
+               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Nii)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Nii)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Nii)  )**2
+            z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
+            !
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "taubot", z2d )           
       ENDIF
          
-      CALL iom_put( "uoce", un(:,:,:) )            ! 3D i-current
-      CALL iom_put(  "ssu", un(:,:,1) )            ! surface i-current
+      CALL iom_put( "uoce", uu(:,:,:,Nii) )            ! 3D i-current
+      CALL iom_put(  "ssu", uu(:,:,1,Nii) )            ! surface i-current
       IF ( iom_use("sbu") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbku(ji,jj)
-               z2d(ji,jj) = un(ji,jj,ikbot)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbku(ji,jj)
+            z2d(ji,jj) = uu(ji,jj,ikbot,Nii)
+         END_2D
          CALL iom_put( "sbu", z2d )                ! bottom i-current
       ENDIF
       
-      CALL iom_put( "voce", vn(:,:,:) )            ! 3D j-current
-      CALL iom_put(  "ssv", vn(:,:,1) )            ! surface j-current
+      CALL iom_put( "voce", vv(:,:,:,Nii) )            ! 3D j-current
+      CALL iom_put(  "ssv", vv(:,:,1,Nii) )            ! surface j-current
       IF ( iom_use("sbv") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkv(ji,jj)
-               z2d(ji,jj) = vn(ji,jj,ikbot)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkv(ji,jj)
+            z2d(ji,jj) = vv(ji,jj,ikbot,Nii)
+         END_2D
          CALL iom_put( "sbv", z2d )                ! bottom j-current
       ENDIF
@@ -217,5 +207,5 @@
          z2d(:,:) = rau0 * e1e2t(:,:)
          DO jk = 1, jpk
-            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+            z3d(:,:,jk) = ww(:,:,jk,Nii) * z2d(:,:)
          END DO
          CALL iom_put( "w_masstr" , z3d )  
@@ -232,15 +222,11 @@
       IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN
          z3d(:,:,jpk) = 0.
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1                                    ! sal gradient
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp  = tsn(ji,jj,jk,jp_sal)
-                  zztmpx = ( tsn(ji+1,jj,jk,jp_sal) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,jk,jp_sal) ) * r1_e1u(ji-1,jj)
-                  zztmpy = ( tsn(ji,jj+1,jk,jp_sal) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,jk,jp_sal) ) * 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
+         DO_3D_00_00( 1, jpkm1 )
+            zztmp  = tsn(ji,jj,jk,jp_sal)
+            zztmpx = ( tsn(ji+1,jj,jk,jp_sal) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,jk,jp_sal) ) * r1_e1u(ji-1,jj)
+            zztmpy = ( tsn(ji,jj+1,jk,jp_sal) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,jk,jp_sal) ) * 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_3D
          CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
          CALL iom_put( "socegrad2",  z3d )          ! square of module of sal gradient
@@ -250,13 +236,11 @@
          
       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
-         DO jj = 2, jpjm1                                    ! sst gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp  = tsn(ji,jj,1,jp_tem)
-               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
-               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
-               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
-                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zztmp  = tsn(ji,jj,1,jp_tem)
+            zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
+            zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
+            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
+               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
@@ -268,11 +252,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_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2)
       ENDIF
@@ -280,11 +260,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_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
@@ -292,11 +268,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_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "salt2c", rau0 * z2d )          ! vertically integrated squared salt content (PSU*kg/m2)
       ENDIF
@@ -304,24 +276,16 @@
       IF ( iom_use("eken") .OR. iom_use("eken_int") ) THEN
          z3d(:,:,jpk) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zztmpx = 0.5 * ( un(ji-1,jj  ,jk) + un(ji,jj,jk) )
-                  zztmpy = 0.5 * ( vn(ji  ,jj-1,jk) + vn(ji,jj,jk) )
-                  z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zztmpx = 0.5 * ( uu(ji-1,jj  ,jk,Nii) + uu(ji,jj,jk,Nii) )
+            zztmpy = 0.5 * ( vv(ji  ,jj-1,jk,Nii) + vv(ji,jj,jk,Nii) )
+            z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy )
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
          CALL iom_put( "eken", 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_n(ji,jj,jk) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk)
+         END_3D
          CALL iom_put( "eken_int", z2d )   ! vertically integrated kinetic energy
       ENDIF
@@ -332,36 +296,24 @@
          
          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  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
-                     &             - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            z3d(ji,jj,jk) = (  e2v(ji+1,jj  ) * vv(ji+1,jj  ,jk,Nii) - e2v(ji,jj) * vv(ji,jj,jk,Nii)    &
+               &             - e1u(ji  ,jj+1) * uu(ji  ,jj+1,jk,Nii) + e1u(ji,jj) * uu(ji,jj,jk,Nii)  ) * 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_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
-                  IF( 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_10_10( 1, jpkm1 )
+            ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+               &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
+            IF( 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
@@ -374,5 +326,5 @@
          z2d(:,:) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
+            z3d(:,:,jk) = rau0 * uu(:,:,jk,Nii) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
             z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
          END DO
@@ -383,11 +335,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) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
@@ -396,11 +344,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) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
@@ -411,5 +355,5 @@
          z3d(:,:,jpk) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
+            z3d(:,:,jk) = rau0 * vv(:,:,jk,Nii) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
          END DO
          CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction
@@ -418,11 +362,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) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
@@ -431,11 +371,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) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
@@ -444,11 +380,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_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
          CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature
@@ -456,11 +388,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_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
          CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity
Index: /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_istate.F90
===================================================================
--- /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_istate.F90	(revision 13468)
+++ /NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_istate.F90	(revision 13469)
@@ -184,9 +184,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_nldj1_nldi1
+               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
@@ -203,24 +201,22 @@
       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:
@@ -240,31 +236,29 @@
          zP0 = rau0 * 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) - rau0 * 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 = rau0 * (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 = rau0 * (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 + (rau0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
-                  pts(ji,jj,jk,jp_tem) = (10._wp + (rau0-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
+            ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y)
+            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rau0 * 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 = rau0 * (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
-         END DO
+            ! temperature:
+            DO jk=1,jpk
+               zdt =  pdept(ji,jj,jk) 
+               zrho1 = rau0 * (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 + (rau0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
+               pts(ji,jj,jk,jp_tem) = (10._wp + (rau0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk)
+            END DO
+         END_2D
          !
          ! salinity:  
@@ -273,37 +267,33 @@
          ! velocities:
          za = 2._wp * zP0 / zlambda**2
-         DO jj = 2, jpjm1
-            DO ji = 2, 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) - rau0 * ff_t(ji,jj) * rn_uzonal
-                     pu(ji,jj,jk) = - zf / ( rau0 * ff_t(ji,jj) ) * zdyPs * 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))
+                  zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rau0 * ff_t(ji,jj) * rn_uzonal
+                  pu(ji,jj,jk) = - zf / ( rau0 * 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
-         !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               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 / ( rau0 * 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
+         !
+         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 / ( rau0 * 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_2D
          !            
          CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
