Changeset 3849 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mapcomm_mod.F90

Timestamp:

2013-03-26T11:45:16+01:00 (11 years ago)

Author:

trackstand2

Message:

Merge branch 'partitioner'

File:

• branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mapcomm_mod.F90 (modified) (9 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mapcomm_mod.F90

@@ -156 +156 @@
 
   ! Public routines
-  PUBLIC :: mapcomms, iprocmap
+  PUBLIC :: mapcomms, iprocmap, set_num_subdomains
 
   ! Public variables
@@ -165 +165 @@
   PUBLIC :: nsendp,nsendp2d,nrecvp,nrecvp2d,npatchsend,npatchrecv, &
             nxsendp,nysendp,nzsendp,nxrecvp,nyrecvp,nzrecvp,       &
-            idesrecvp,jdesrecvp,isrcsendp,jsrcsendp
+            idesrecvp,jdesrecvp,isrcsendp,jsrcsendp, nprocp
 
   PUBLIC :: ielb,  ieub,  pielb, pjelb, pieub, pjeub,                    &
             iesub, jesub, jeub, ilbext, iubext, jubext, jlbext, pnactive,&
-            piesub, pjesub, jelb, pilbext, pjlbext, pjubext, piubext,    &
-            nprocp
+            piesub, pjesub, jelb, pilbext, pjlbext, pjubext, piubext
 
   PUBLIC :: NONE         &
@@ -191 +190 @@
 
   ! Switch for trimming points below ocean floor from halo swaps
-  !LOGICAL, PARAMETER :: msgtrim_z = .TRUE. ! .FALSE.
-  LOGICAL, PUBLIC, SAVE      :: msgtrim_z
+  ! Defaults to true unless set via NEMO_MSGTRIM_Z environment var.
+  LOGICAL, PUBLIC, SAVE :: msgtrim_z
 
 CONTAINS
+
+  SUBROUTINE set_num_subdomains(npes)
+    IMPLICIT none
+    !!------------------------------------------------------------------
+    !! Set the number of subdomains to partition the domain into.
+    !!------------------------------------------------------------------
+    INTEGER, INTENT(in) :: npes
+
+    nprocp = npes
+
+  END SUBROUTINE set_num_subdomains
+
 
   SUBROUTINE mapcomms ( depth, ibotlvl, nx, ny, jperio, ierr )
@@ -213 +224 @@
 
     ! Local variables.
-    INTEGER :: i, i1, i2, icol, ihalo, iproc, iprocc, iprocx, &
-               iprocy, j, j1, j2, lumapout, nadd, naddmaxr, naddmaxs
+    INTEGER :: i, i1, i2, ihalo, iproc, iprocc, iprocx, &
+               iprocy, j, j1, j2, nadd, naddmaxr, naddmaxs
     INTEGER :: ldiff0, ldiff1 ! Local vars for coping with wrapping of coords
     INTEGER :: imax, imin ! Max/min value of i that a halo strip can run 
@@ -1302 +1313 @@
         IF ( addcorner ) THEN
 #if defined ARPDEBUG
-          WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I2,', dir = ',I1)") &
+          WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I4,', dir = ',I1)") &
                  narea-1, procid(iprocc),i
 #endif
@@ -1314 +1325 @@
 
 #if defined ARPDEBUG
-          WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I3,', old dir = ',I1,' new dir = ',I1)") &
+          WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I4,', old dir = ',I1,' new dir = ',I1)") &
                  narea-1, procid(iprocc),i, j
 #endif
@@ -1380 +1391 @@
 ! ARP - for debugging only
 !!$        IF(iprocmap == 0)THEN
-!!$           WRITE(*,"('iprocmap: failed to find owner PE for (',I3,I3,')')") ia, ja
+!!$           WRITE(*,"('iprocmap: failed to find owner PE for (',I3,1x,I3,')')") ia, ja
 !!$           WRITE(*,*) 'PE domains are [xmin:xmax][ymin:ymax]:'
 !!$           DO iproc=1,nprocp,1
@@ -1826 +1837 @@
 
         ! Can any points along the left (low i) edge be trimmed?
-        left_edge: DO i=ilo, ihi - nextra
+        left_edge: DO i=ilo, ihi
           DO j=jlo, jhi
              ! depth is global mask, i and j are local coords
@@ -1856 +1867 @@
 
         ! Can any points along the right (high i) edge be trimmed?
-        right_edge: DO i=ihi, ilo + nextra, -1
+        right_edge: DO i=ihi, ilo, -1
           DO j=jlo, jhi
 !            IF (depth(i+nimpp-1-nextra,j+njmpp-1) .ne. land) exit right_edge