pkg/exch2/w2_map_procs.F

C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.14 2011/07/09 21:52:34 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP
C     !ROUTINE: W2_MAP_PROCS

C     !INTERFACE:
      SUBROUTINE W2_MAP_PROCS( myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE W2_MAP_PROCS
C     | o Setup Mapping of W2-topology tiles to processes
C     *==========================================================*
C     | Set which process "own" which tiles
C     | and store the 2-way relation between, on one side,
C     |  tile Id from W2-topology and, on the other side,
C     |  process Id with local tile indices bi,bj.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     !INPUT PARAMETERS:
C     myThid  :: my Thread Id number
C               (Note: not relevant since threading has not yet started)
      INTEGER myThid
CEOP

C     !FUNCTIONS:

C     !LOCAL VARIABLES:
      INTEGER thisProc
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      CHARACTER commFlag
      INTEGER myTileId
      INTEGER I, J
      INTEGER np, ii, jj, bi, bj
      INTEGER iErr, tNx, tNy

C--   Initialise common blocs W2_MAP_TILE2PROC & W2_EXCH2_COMMFLAG:
      DO I = 1,W2_maxNbTiles
        W2_tileProc(I)  = 0
c       W2_tileIndex(I) = 0
c       W2_tileRank(I)  = 0
      ENDDO
      DO bj=1,nSy
       DO bi=1,nSx
         W2_myTileList(bi,bj) = 0
         DO np=1,nPx*nPy
           W2_procTileList(bi,bj,np) = 0
         ENDDO
         DO J=1,W2_maxNeighbours
           W2_myCommFlag(J,bi,bj) = ' '
         ENDDO
       ENDDO
      ENDDO

C--   Decide which tiles this process handles - do this inline for now, but
C     should go in subroutine.
C     Set which rank processes "own" which tiles. This should probably
C     be queried as part of some hand-shaking but for now we use the
C     functional relationship that was used above.
C     Fill also W2_procTileList for Single-CPU-IO.

C     Number of tiles I handle is nSx*nSy
      thisProc = 1 + myProcId
      J = 0
      DO I=1,exch2_nTiles
       IF ( exch2_myFace(I) .NE. 0 ) THEN
C--   old ordering (makes no difference if nSy*nPy=1 )
c       np = 1 + J/(nSx*nSy)
c       jj = MOD(J,nSx*nSy)
c       bj = 1 + jj/nSx
c       bi = 1 + MOD(jj,nSx)
C--   new ordering: for single sub-domain (nFacets=1) case, match default setting
        jj = J/(nSx*nPx)
        ii = MOD(J,nSx*nPx)
C--   natural way to order processors:
c       np = 1 + ii/nSx + (jj/nSy)*nPx
C--   switch processor order to match MPI_CART set-up
        np = 1 + jj/nSy + (ii/nSx)*nPy
        bj = 1 + MOD(jj,nSy)
        bi = 1 + MOD(ii,nSx)
C--
        W2_tileProc(I) = np
c       W2_tileIndex(I)= bi + (bj-1)*nSx
        W2_procTileList(bi,bj,np) = I
        IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I
        J = J + 1
c       W2_tileRank(I) = J
       ENDIF
      ENDDO
      IF ( J .NE. nSx*nSy*nPx*nPy ) THEN
       STOP
     & 'ERROR W2_MAP_PROCS: number of active tiles not =nPx*nSx*nPy*nSy'
      ENDIF

C--   Check tile sizes
      iErr = 0
      DO bj=1,nSy
       DO bi=1,nSx
        myTileId = W2_myTileList(bi,bj)
        tNx = exch2_tNx(myTileId)
        tNy = exch2_tNy(myTileId)
        IF ( tNx .NE. sNx ) THEN
         WRITE(msgBuf,'(3(A,I5))')
     &   'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
     &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
         CALL PRINT_MESSAGE(msgBuf,
     &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
         iErr = iErr+1
        ENDIF
        IF ( tNy .NE. sNy ) THEN
         WRITE(msgBuf,'(3(A,I5))')
     &   'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
     &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
         CALL PRINT_MESSAGE(msgBuf,
     &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
         iErr = iErr+1
        ENDIF
       ENDDO
      ENDDO
      IF ( iErr .NE. 0 ) THEN
       STOP 'ABNORMAL END: W2_MAP_PROCS'
      ENDIF

C--   Print tiles connection for this process and set myCommonFlag :
      WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
      CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
      DO bj=1,nSy
       DO bi=1,nSx
        myTileId = W2_myTileList(bi,bj)
        WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,
     &       ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
c       WRITE(msgBuf,'(2(A,I5),A,I3)') ' TILE: ', myTileId,
c    &       ' , rank=', W2_tileRank(myTileId),
c    &       ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
        DO J=1,exch2_nNeighbours(myTileId)
         commFlag = 'M'
         DO jj=1,nSy
          DO ii=1,nSx
          IF ( W2_myTileList(ii,jj).EQ.exch2_neighbourId(J,myTileId) )
     &     commFlag = 'P'
          ENDDO
         ENDDO
         IF ( commFlag .EQ. 'M' ) THEN
          WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
     &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
     &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = MSG',
     &    ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
         ENDIF
         IF ( commFlag .EQ. 'P' ) THEN
          WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
     &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
     &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
     &    ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
         ENDIF
         W2_myCommFlag(J,bi,bj) = commFlag
        ENDDO
       ENDDO
      ENDDO

      RETURN
      END
1	jmc	1.1	C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.14 2011/07/09 21:52:34 jmc Exp $
2			C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			CBOP
7			C !ROUTINE: W2_MAP_PROCS
8
9			C !INTERFACE:
10			SUBROUTINE W2_MAP_PROCS( myThid )
11
12			C !DESCRIPTION:
13			C ==========================================================
14			C \| SUBROUTINE W2_MAP_PROCS
15			C \| o Setup Mapping of W2-topology tiles to processes
16			C ==========================================================
17			C \| Set which process "own" which tiles
18			C \| and store the 2-way relation between, on one side,
19			C \| tile Id from W2-topology and, on the other side,
20			C \| process Id with local tile indices bi,bj.
21			C ==========================================================
22
23			C !USES:
24			IMPLICIT NONE
25
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "W2_EXCH2_SIZE.h"
29			#include "W2_EXCH2_TOPOLOGY.h"
30			#include "W2_EXCH2_PARAMS.h"
31
32			C !INPUT PARAMETERS:
33			C myThid :: my Thread Id number
34			C (Note: not relevant since threading has not yet started)
35			INTEGER myThid
36			CEOP
37
38			C !FUNCTIONS:
39
40			C !LOCAL VARIABLES:
41			INTEGER thisProc
42			CHARACTER*(MAX_LEN_MBUF) msgBuf
43			CHARACTER commFlag
44			INTEGER myTileId
45			INTEGER I, J
46			INTEGER np, ii, jj, bi, bj
47			INTEGER iErr, tNx, tNy
48
49			C-- Initialise common blocs W2_MAP_TILE2PROC & W2_EXCH2_COMMFLAG:
50			DO I = 1,W2_maxNbTiles
51			W2_tileProc(I) = 0
52			c W2_tileIndex(I) = 0
53			c W2_tileRank(I) = 0
54			ENDDO
55			DO bj=1,nSy
56			DO bi=1,nSx
57			W2_myTileList(bi,bj) = 0
58			DO np=1,nPx*nPy
59			W2_procTileList(bi,bj,np) = 0
60			ENDDO
61			DO J=1,W2_maxNeighbours
62			W2_myCommFlag(J,bi,bj) = ' '
63			ENDDO
64			ENDDO
65			ENDDO
66
67			C-- Decide which tiles this process handles - do this inline for now, but
68			C should go in subroutine.
69			C Set which rank processes "own" which tiles. This should probably
70			C be queried as part of some hand-shaking but for now we use the
71			C functional relationship that was used above.
72			C Fill also W2_procTileList for Single-CPU-IO.
73
74			C Number of tiles I handle is nSx*nSy
75			thisProc = 1 + myProcId
76			J = 0
77			DO I=1,exch2_nTiles
78			IF ( exch2_myFace(I) .NE. 0 ) THEN
79			C-- old ordering (makes no difference if nSy*nPy=1 )
80			c np = 1 + J/(nSx*nSy)
81			c jj = MOD(J,nSx*nSy)
82			c bj = 1 + jj/nSx
83			c bi = 1 + MOD(jj,nSx)
84			C-- new ordering: for single sub-domain (nFacets=1) case, match default setting
85			jj = J/(nSx*nPx)
86			ii = MOD(J,nSx*nPx)
87			C-- natural way to order processors:
88			c np = 1 + ii/nSx + (jj/nSy)*nPx
89			C-- switch processor order to match MPI_CART set-up
90			np = 1 + jj/nSy + (ii/nSx)*nPy
91			bj = 1 + MOD(jj,nSy)
92			bi = 1 + MOD(ii,nSx)
93			C--
94			W2_tileProc(I) = np
95			c W2_tileIndex(I)= bi + (bj-1)*nSx
96			W2_procTileList(bi,bj,np) = I
97			IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I
98			J = J + 1
99			c W2_tileRank(I) = J
100			ENDIF
101			ENDDO
102			IF ( J .NE. nSxnSynPx*nPy ) THEN
103			STOP
104			& 'ERROR W2_MAP_PROCS: number of active tiles not =nPxnSxnPy*nSy'
105			ENDIF
106
107			C-- Check tile sizes
108			iErr = 0
109			DO bj=1,nSy
110			DO bi=1,nSx
111			myTileId = W2_myTileList(bi,bj)
112			tNx = exch2_tNx(myTileId)
113			tNy = exch2_tNy(myTileId)
114			IF ( tNx .NE. sNx ) THEN
115			WRITE(msgBuf,'(3(A,I5))')
116			& 'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
117			& 'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
118			CALL PRINT_MESSAGE(msgBuf,
119			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
120			iErr = iErr+1
121			ENDIF
122			IF ( tNy .NE. sNy ) THEN
123			WRITE(msgBuf,'(3(A,I5))')
124			& 'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
125			& 'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
126			CALL PRINT_MESSAGE(msgBuf,
127			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
128			iErr = iErr+1
129			ENDIF
130			ENDDO
131			ENDDO
132			IF ( iErr .NE. 0 ) THEN
133			STOP 'ABNORMAL END: W2_MAP_PROCS'
134			ENDIF
135
136			C-- Print tiles connection for this process and set myCommonFlag :
137			WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
138			CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
139			DO bj=1,nSy
140			DO bi=1,nSx
141			myTileId = W2_myTileList(bi,bj)
142			WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,
143			& ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
144			c WRITE(msgBuf,'(2(A,I5),A,I3)') ' TILE: ', myTileId,
145			c & ' , rank=', W2_tileRank(myTileId),
146			c & ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
147			CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
148			DO J=1,exch2_nNeighbours(myTileId)
149			commFlag = 'M'
150			DO jj=1,nSy
151			DO ii=1,nSx
152			IF ( W2_myTileList(ii,jj).EQ.exch2_neighbourId(J,myTileId) )
153			& commFlag = 'P'
154			ENDDO
155			ENDDO
156			IF ( commFlag .EQ. 'M' ) THEN
157			WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
158			& ' NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
159			& ' (n=', exch2_opposingSend(J,myTileId), ') Comm = MSG',
160			& ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
161			CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
162			ENDIF
163			IF ( commFlag .EQ. 'P' ) THEN
164			WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
165			& ' NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
166			& ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
167			& ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
168			CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
169			ENDIF
170			W2_myCommFlag(J,bi,bj) = commFlag
171			ENDDO
172			ENDDO
173			ENDDO
174
175			RETURN
176			END