pkg/exch2/w2_eeboot.F

C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.3 2004/04/06 00:42:17 dimitri Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP             
C     !ROUTINE: W2_EEBOOT

C     !INTERFACE:
      SUBROUTINE W2_EEBOOT
      IMPLICIT NONE

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE W2_EEBOOT                                         
C     | o Setup execution "environment" for WRAPPER2             
C     *==========================================================*
C     | WRAPPER2 provides complex topology support. In this routine
C     | we setup the base topology for the default halo operations.
C     *==========================================================*
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     == Local variables ==
      INTEGER nt_check, nt_perproc
      INTEGER thisPtileLo, thisPtileHi
      CHARACTER*(MAX_LEN_MBUF) msgBuffer
      CHARACTER commFlag
      INTEGER myTileId
      INTEGER myThid, I, J, II
      INTEGER iErr, tNx, tNy
      INTEGER pRank
      INTEGER npe,itemp(nSx),mpiBufSize,mpiRequest
#ifdef ALLOW_USE_MPI
      INTEGER istatus(MPI_STATUS_SIZE)
#endif

C     Set dummy myThid value (we are not multi-threaded here)
      myThid = 1
 
C     Define toplogy for every tile
      CALL W2_E2SETUP

C     Decide which tiles this process handles - do this inline for now, but
C     should go in subroutine.
C     Total number of tiles should be divisible by nPx and nSx
C     ( there is no two dimensional decomposition for W2 ) and
C     number of tiles per process should be nSx
      nt_check = NTILES/(nPx*nSx)
      nt_check = nt_check*nPx*nSx
      IF ( nt_check .NE. NTILES ) THEN
      STOP 
     &'ERROR: W2_EEBOOT number of tiles is not divisible by nPx*nSx'
      ENDIF
      nt_perproc = NTILES/nPx
      IF ( nt_perproc .NE. nSx ) THEN
      STOP 
     &'ERROR: W2_EEBOOT tiles per process is not equal to nSx'
      ENDIF
C     Number of tiles I handle is nSx, range of tile numbers I handle
C     depends on my rank.
#ifdef ALLOW_USE_MPI
      thisPtileLo = myPid*nt_perproc+1
      thisPtileHi = (myPid+1)*nt_perproc
#else
      thisPtileLo = 1
      thisPtileHi = nt_perproc
#endif
      DO I=thisPtileLo, thisPtileHi
       W2_myTileList(I-thisPtileLo+1)=I
      ENDDO
      iErr = 0

      DO I=1,nSx
C      Check tile sizes
       myTileId = W2_myTileList(I)
       tnx = exch2_tnx(myTileId)
       tny = exch2_tny(myTileId)
       IF ( tnx .NE. sNx ) THEN
        WRITE(msgBuffer,'(A,I4,A,I4)')
     &   'ERROR: S/R W2_EEBOOT Topology tnx=',
     &   tnx,
     &   ' is not equal to subgrid size sNx=',
     &   sNx
         CALL PRINT_MESSAGE(msgBuffer, 
     &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
         iErr = iErr+1
       ENDIF
       IF ( tny .NE. sNy ) THEN
        WRITE(msgBuffer,'(A,I4,A,I4,A,I4)')
     &   'ERROR: S/R W2_EEBOOT Topology for tile ',myTileId,
     &   'tny=',
     &   tny,
     &   ' is not equal to subgrid size sNy=',
     &   sNy
         CALL PRINT_MESSAGE(msgBuffer, 
     &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
         iErr = iErr+1
       ENDIF
      ENDDO
      IF ( iErr .NE. 0 ) THEN
       STOP 'ABNORMAL END: W2_EEBOOT'
      ENDIF

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     functiional relationship that was used above.
      DO I=1,nTiles
       pRank = (I-1)/nt_perproc
       exch2_tProc(I) = pRank+1
      ENDDO

      WRITE(msgBuffer,'(A)') '===== W2 TILE TOPLOGY ====='
      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
     &     SQUEEZE_BOTH,myThid)
      DO I=1,nSx
       myTileId = W2_myTileList(I)
       WRITE(msgBuffer,'(A,I4)') ' TILE: ', myTileId
       CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
     &      SQUEEZE_RIGHT,myThid)
       DO J=1,exch2_nNeighbours(myTileId)
        commFlag = 'M'
        DO II=1,nSx
         IF ( W2_myTileList(II) .EQ. exch2_neighbourId(J,myTileId) )
     &    commFlag = 'P'
        ENDDO
        IF ( commFlag .EQ. 'M' ) THEN
         WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
     &   '      NEIGHBOUR ',J,' = TILE ', 
     &   exch2_neighbourId(J,myTileId), ' Comm = MSG',
     &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
         CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
     &        SQUEEZE_RIGHT,myThid)
        ENDIF
        IF ( commFlag .EQ. 'P' ) THEN
         WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
     &   '      NEIGHBOUR ',J,' = TILE ', 
     &   exch2_neighbourId(J,myTileId), ' Comm = PUT',
     &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
         CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
     &        SQUEEZE_RIGHT,myThid)
        ENDIF
        W2_myCommFlag(J,I) = commFlag
       ENDDO
      ENDDO

C     Fill in values for W2_mpi_myTileList
#ifdef ALLOW_USE_MPI
      mpiBufSize=nSx
      mpiRequest=0
      DO npe = 0, numberOfProcs-1
         CALL MPI_ISEND (W2_myTileList, mpiBufSize, MPI_INTEGER,
     &        npe, mpiMyId, MPI_COMM_MODEL, mpiRequest, ierr)
      ENDDO
      DO npe = 0, numberOfProcs-1
         CALL MPI_RECV (itemp, mpiBufSize, MPI_INTEGER,
     &        npe, npe, MPI_COMM_MODEL, istatus, ierr)
         DO I=1,nSx
            W2_mpi_myTileList(npe+1,I)=itemp(I)
         ENDDO
      ENDDO
#else /* ALLOW_USE_MPI */
      DO I=1,nSx
         W2_mpi_myTileList(1,I)=W2_myTileList(I)
      ENDDO
#endif /* ALLOW_USE_MPI */

C     Print out the topology communication schedule
      CALL W2_PRINT_COMM_SEQUENCE
C
      RETURN
      END
1	edhill	1.4	C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.3 2004/04/06 00:42:17 dimitri Exp $
2	afe	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			CBOP
7			C !ROUTINE: W2_EEBOOT
8
9			C !INTERFACE:
10			SUBROUTINE W2_EEBOOT
11			IMPLICIT NONE
12
13			C !DESCRIPTION:
14			C ==========================================================
15			C \| SUBROUTINE W2_EEBOOT
16			C \| o Setup execution "environment" for WRAPPER2
17			C ==========================================================
18			C \| WRAPPER2 provides complex topology support. In this routine
19			C \| we setup the base topology for the default halo operations.
20			C ==========================================================
21			#include "SIZE.h"
22			#include "EEPARAMS.h"
23			#include "EESUPPORT.h"
24			#include "W2_EXCH2_TOPOLOGY.h"
25			#include "W2_EXCH2_PARAMS.h"
26
27			C == Local variables ==
28			INTEGER nt_check, nt_perproc
29			INTEGER thisPtileLo, thisPtileHi
30			CHARACTER*(MAX_LEN_MBUF) msgBuffer
31			CHARACTER commFlag
32			INTEGER myTileId
33			INTEGER myThid, I, J, II
34			INTEGER iErr, tNx, tNy
35			INTEGER pRank
36	dimitri	1.3	INTEGER npe,itemp(nSx),mpiBufSize,mpiRequest
37			#ifdef ALLOW_USE_MPI
38			INTEGER istatus(MPI_STATUS_SIZE)
39			#endif
40	afe	1.1
41	edhill	1.4	C Set dummy myThid value (we are not multi-threaded here)
42	afe	1.1	myThid = 1
43
44			C Define toplogy for every tile
45			CALL W2_E2SETUP
46
47	dimitri	1.2	C Decide which tiles this process handles - do this inline for now, but
48	afe	1.1	C should go in subroutine.
49			C Total number of tiles should be divisible by nPx and nSx
50			C ( there is no two dimensional decomposition for W2 ) and
51			C number of tiles per process should be nSx
52			nt_check = NTILES/(nPx*nSx)
53			nt_check = nt_checknPxnSx
54			IF ( nt_check .NE. NTILES ) THEN
55			STOP
56			&'ERROR: W2_EEBOOT number of tiles is not divisible by nPx*nSx'
57			ENDIF
58			nt_perproc = NTILES/nPx
59			IF ( nt_perproc .NE. nSx ) THEN
60			STOP
61			&'ERROR: W2_EEBOOT tiles per process is not equal to nSx'
62			ENDIF
63			C Number of tiles I handle is nSx, range of tile numbers I handle
64			C depends on my rank.
65			#ifdef ALLOW_USE_MPI
66			thisPtileLo = myPid*nt_perproc+1
67			thisPtileHi = (myPid+1)*nt_perproc
68			#else
69			thisPtileLo = 1
70			thisPtileHi = nt_perproc
71			#endif
72			DO I=thisPtileLo, thisPtileHi
73			W2_myTileList(I-thisPtileLo+1)=I
74			ENDDO
75			iErr = 0
76
77			DO I=1,nSx
78			C Check tile sizes
79			myTileId = W2_myTileList(I)
80			tnx = exch2_tnx(myTileId)
81			tny = exch2_tny(myTileId)
82			IF ( tnx .NE. sNx ) THEN
83			WRITE(msgBuffer,'(A,I4,A,I4)')
84			& 'ERROR: S/R W2_EEBOOT Topology tnx=',
85			& tnx,
86			& ' is not equal to subgrid size sNx=',
87			& sNx
88			CALL PRINT_MESSAGE(msgBuffer,
89			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
90			iErr = iErr+1
91			ENDIF
92			IF ( tny .NE. sNy ) THEN
93			WRITE(msgBuffer,'(A,I4,A,I4,A,I4)')
94			& 'ERROR: S/R W2_EEBOOT Topology for tile ',myTileId,
95			& 'tny=',
96			& tny,
97			& ' is not equal to subgrid size sNy=',
98			& sNy
99			CALL PRINT_MESSAGE(msgBuffer,
100			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
101			iErr = iErr+1
102			ENDIF
103			ENDDO
104			IF ( iErr .NE. 0 ) THEN
105			STOP 'ABNORMAL END: W2_EEBOOT'
106			ENDIF
107
108			C Set which rank processes "own" which tiles. This should probably
109			C be queried as part of some hand-shaking but for now we use the
110			C functiional relationship that was used above.
111			DO I=1,nTiles
112			pRank = (I-1)/nt_perproc
113			exch2_tProc(I) = pRank+1
114			ENDDO
115
116			WRITE(msgBuffer,'(A)') '===== W2 TILE TOPLOGY ====='
117			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
118			& SQUEEZE_BOTH,myThid)
119			DO I=1,nSx
120			myTileId = W2_myTileList(I)
121			WRITE(msgBuffer,'(A,I4)') ' TILE: ', myTileId
122			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
123			& SQUEEZE_RIGHT,myThid)
124			DO J=1,exch2_nNeighbours(myTileId)
125			commFlag = 'M'
126			DO II=1,nSx
127			IF ( W2_myTileList(II) .EQ. exch2_neighbourId(J,myTileId) )
128			& commFlag = 'P'
129			ENDDO
130			IF ( commFlag .EQ. 'M' ) THEN
131			WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
132			& ' NEIGHBOUR ',J,' = TILE ',
133			& exch2_neighbourId(J,myTileId), ' Comm = MSG',
134			& ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
135			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
136			& SQUEEZE_RIGHT,myThid)
137			ENDIF
138			IF ( commFlag .EQ. 'P' ) THEN
139			WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
140			& ' NEIGHBOUR ',J,' = TILE ',
141			& exch2_neighbourId(J,myTileId), ' Comm = PUT',
142			& ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
143			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
144			& SQUEEZE_RIGHT,myThid)
145			ENDIF
146			W2_myCommFlag(J,I) = commFlag
147			ENDDO
148			ENDDO
149	dimitri	1.2
150			C Fill in values for W2_mpi_myTileList
151			#ifdef ALLOW_USE_MPI
152			mpiBufSize=nSx
153			mpiRequest=0
154			DO npe = 0, numberOfProcs-1
155			CALL MPI_ISEND (W2_myTileList, mpiBufSize, MPI_INTEGER,
156			& npe, mpiMyId, MPI_COMM_MODEL, mpiRequest, ierr)
157			ENDDO
158			DO npe = 0, numberOfProcs-1
159			CALL MPI_RECV (itemp, mpiBufSize, MPI_INTEGER,
160			& npe, npe, MPI_COMM_MODEL, istatus, ierr)
161			DO I=1,nSx
162			W2_mpi_myTileList(npe+1,I)=itemp(I)
163			ENDDO
164			ENDDO
165			#else /* ALLOW_USE_MPI */
166			DO I=1,nSx
167			W2_mpi_myTileList(1,I)=W2_myTileList(I)
168			ENDDO
169			#endif /* ALLOW_USE_MPI */
170
171	afe	1.1	C Print out the topology communication schedule
172			CALL W2_PRINT_COMM_SEQUENCE
173			C
174			RETURN
175			END