Index: NEMO/branches/2020/dev_r13541_TOP-01_rlod_Antarctic_ice_Sheet_Fe_Source/src/OCE/IOM/prtctl.F90
===================================================================
--- NEMO/branches/2020/dev_r13541_TOP-01_rlod_Antarctic_ice_Sheet_Fe_Source/src/OCE/IOM/prtctl.F90	(revision 13543)
+++ NEMO/branches/2020/dev_r13541_TOP-01_rlod_Antarctic_ice_Sheet_Fe_Source/src/OCE/IOM/prtctl.F90	(revision 14015)
@@ -8,4 +8,5 @@
    !!----------------------------------------------------------------------
    USE dom_oce          ! ocean space and time domain variables
+   USE domutl, ONLY : is_tile
    USE in_out_manager   ! I/O manager
    USE mppini           ! distributed memory computing
@@ -26,4 +27,6 @@
    PUBLIC prt_ctl_init    ! called by nemogcm.F90 and prt_ctl_trc_init
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -35,4 +38,33 @@
    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2,   &
       &                 clinfo, clinfo1, clinfo2, clinfo3, kdim )
+      !!
+      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1
+      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1
+      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1
+      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2
+      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2
+      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1
+      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2
+      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array
+      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1
+      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo2
+      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo3
+      INTEGER                             , INTENT(in), OPTIONAL ::   kdim
+      !
+      INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2
+      !!
+      IF( PRESENT(tab2d_1)  ) THEN ; itab2d_1 = is_tile(tab2d_1)  ; ELSE ; itab2d_1 = 0 ; ENDIF
+      IF( PRESENT(tab3d_1)  ) THEN ; itab3d_1 = is_tile(tab3d_1)  ; ELSE ; itab3d_1 = 0 ; ENDIF
+      IF( PRESENT(tab4d_1)  ) THEN ; itab4d_1 = is_tile(tab4d_1)  ; ELSE ; itab4d_1 = 0 ; ENDIF
+      IF( PRESENT(tab2d_2)  ) THEN ; itab2d_2 = is_tile(tab2d_2)  ; ELSE ; itab2d_2 = 0 ; ENDIF
+      IF( PRESENT(tab3d_2)  ) THEN ; itab3d_2 = is_tile(tab3d_2)  ; ELSE ; itab3d_2 = 0 ; ENDIF
+
+      CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2,  &
+      &               mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim )
+   END SUBROUTINE prt_ctl
+
+
+   SUBROUTINE prt_ctl_t (tab2d_1, ktab2d_1, tab3d_1, ktab3d_1, tab4d_1, ktab4d_1, tab2d_2, ktab2d_2, tab3d_2, ktab3d_2,  &
+      &                  mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE prt_ctl  ***
@@ -70,9 +102,10 @@
       !!                    clinfo3 : additional information 
       !!----------------------------------------------------------------------
-      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1
-      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1
-      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1
-      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2
-      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2
+      INTEGER                             , INTENT(in)           ::   ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2
+      REAL(wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1
+      REAL(wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1
+      REAL(wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1
+      REAL(wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2
+      REAL(wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2
       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1
       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2
@@ -106,8 +139,8 @@
 
          ! define shoter names...
-         iis = nall_ictls(jl)
-         iie = nall_ictle(jl)
-         jjs = nall_jctls(jl)
-         jje = nall_jctle(jl)
+         iis = MAX( nall_ictls(jl), ntsi )
+         iie = MIN( nall_ictle(jl), ntei )
+         jjs = MAX( nall_jctls(jl), ntsj )
+         jje = MIN( nall_jctle(jl), ntej )
 
          IF( PRESENT(clinfo) ) THEN   ;   inum = numprt_top(jl)
@@ -115,83 +148,86 @@
          ENDIF
 
-         DO jn = 1, itra
-
-            IF( PRESENT(clinfo3) ) THEN
-               IF    ( clinfo3 == 'tra-ta' )   THEN
-                  zvctl1 = t_ctl(jl)
-               ELSEIF( clinfo3 == 'tra'    )   THEN
-                  zvctl1 = t_ctl(jl)
-                  zvctl2 = s_ctl(jl)
-               ELSEIF( clinfo3 == 'dyn'    )   THEN
-                  zvctl1 = u_ctl(jl)
-                  zvctl2 = v_ctl(jl)
+         ! Compute the sum control only where the tile domain and control print area overlap
+         IF( iie >= iis .AND. jje >= jjs ) THEN
+            DO jn = 1, itra
+
+               IF( PRESENT(clinfo3) ) THEN
+                  IF    ( clinfo3 == 'tra-ta' )   THEN
+                     zvctl1 = t_ctl(jl)
+                  ELSEIF( clinfo3 == 'tra'    )   THEN
+                     zvctl1 = t_ctl(jl)
+                     zvctl2 = s_ctl(jl)
+                  ELSEIF( clinfo3 == 'dyn'    )   THEN
+                     zvctl1 = u_ctl(jl)
+                     zvctl2 = v_ctl(jl)
+                  ELSE
+                     zvctl1 = tra_ctl(jn,jl)
+                  ENDIF
+               ENDIF
+
+               ! 2D arrays
+               IF( PRESENT(tab2d_1) ) THEN
+                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) )
+                  ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(tab2d_2) ) THEN
+                  IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) )
+                  ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            )
+                  ENDIF
+               ENDIF
+
+               ! 3D arrays
+               IF( PRESENT(tab3d_1) ) THEN
+                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) )
+                  ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(tab3d_2) ) THEN
+                  IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) )
+                  ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 )
+                  ENDIF
+               ENDIF
+
+               ! 4D arrays
+               IF( PRESENT(tab4d_1) ) THEN
+                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) )
+                  ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 )
+                  ENDIF
+               ENDIF
+
+               ! Print the result
+               IF( PRESENT(clinfo ) )   cl1  = clinfo(jn)
+               IF( PRESENT(clinfo3) )   THEN
+                  !
+                  IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN
+                     WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2
+                  ELSE
+                     WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1
+                  ENDIF
+                  !
+                  SELECT CASE( clinfo3 )
+                  CASE ( 'tra-ta' )
+                     t_ctl(jl) = zsum1
+                  CASE ( 'tra' )
+                     t_ctl(jl) = zsum1
+                     s_ctl(jl) = zsum2
+                  CASE ( 'dyn' )
+                     u_ctl(jl) = zsum1
+                     v_ctl(jl) = zsum2
+                  CASE default
+                     tra_ctl(jn,jl) = zsum1
+                  END SELECT
+               ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
+                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2
                ELSE
-                  zvctl1 = tra_ctl(jn,jl)
-               ENDIF
-            ENDIF
-
-            ! 2D arrays
-            IF( PRESENT(tab2d_1) ) THEN
-               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) )
-               ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            )
-               ENDIF
-            ENDIF
-            IF( PRESENT(tab2d_2) ) THEN
-               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) )
-               ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            )
-               ENDIF
-            ENDIF
-
-            ! 3D arrays
-            IF( PRESENT(tab3d_1) ) THEN
-               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) )
-               ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 )
-               ENDIF
-            ENDIF
-            IF( PRESENT(tab3d_2) ) THEN
-               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) )
-               ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 )
-               ENDIF
-            ENDIF
-
-            ! 4D arrays
-            IF( PRESENT(tab4d_1) ) THEN
-               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) )
-               ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 )
-               ENDIF
-            ENDIF
-
-            ! Print the result
-            IF( PRESENT(clinfo ) )   cl1  = clinfo(jn)
-            IF( PRESENT(clinfo3) )   THEN
-               !
-               IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN
-                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2
-               ELSE
-                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1
-               ENDIF
-               !
-               SELECT CASE( clinfo3 )
-               CASE ( 'tra-ta' ) 
-                  t_ctl(jl) = zsum1
-               CASE ( 'tra' ) 
-                  t_ctl(jl) = zsum1
-                  s_ctl(jl) = zsum2
-               CASE ( 'dyn' ) 
-                  u_ctl(jl) = zsum1
-                  v_ctl(jl) = zsum2
-               CASE default
-                  tra_ctl(jn,jl) = zsum1
-               END SELECT
-            ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
-               WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2
-            ELSE
-               WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1
-            ENDIF
-
-         END DO
+                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1
+               ENDIF
+
+            END DO
+         ENDIF
       END DO
       !
-   END SUBROUTINE prt_ctl
+   END SUBROUTINE prt_ctl_t
 
 
