Index: NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90
===================================================================
--- NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90	(revision 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 13467)
+++ 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 )
