Index: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/lib_fortran.F90
===================================================================
--- NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/lib_fortran.F90	(revision 11947)
+++ NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/lib_fortran.F90	(revision 12340)
@@ -63,4 +63,6 @@
 #endif
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -215,64 +217,60 @@
       IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi 
+      DO_2D_11_11
+         IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+            IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+               p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+            ENDIF
+         ENDIF
+      END_2D
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
+         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
+         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_2d
+
+   SUBROUTINE sum3x3_3d( p3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_3d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
+      !
+      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
+      INTEGER ::   ipn                      ! Third dimension size
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
+      ipn = SIZE(p3d,3)
+      !
+      DO jn = 1, ipn
+         DO_2D_11_11
             IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
                ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
                jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
                IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
-                  p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
                ENDIF
             ENDIF
-         END DO
-      END DO
-      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
-      IF( nbondi /= -1 ) THEN
-         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
-         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
-      ENDIF
-      IF( nbondi /=  1 ) THEN
-         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
-         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
-      ENDIF
-      IF( nbondj /= -1 ) THEN
-         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
-         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
-      ENDIF
-      IF( nbondj /=  1 ) THEN
-         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
-         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
-      ENDIF
-      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
-
-   END SUBROUTINE sum3x3_2d
-
-   SUBROUTINE sum3x3_3d( p3d )
-      !!-----------------------------------------------------------------------
-      !!                  ***  routine sum3x3_3d  ***
-      !!
-      !! ** Purpose : sum over 3x3 boxes
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
-      !
-      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
-      INTEGER ::   ipn                      ! Third dimension size
-      !!----------------------------------------------------------------------
-      !
-      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
-      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
-      ipn = SIZE(p3d,3)
-      !
-      DO jn = 1, ipn
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
-                  ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
-                  jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
-                  IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
-                     p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
+         END_2D
       END DO
       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
