pkg/exch2/w2_eeboot.F

C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.1 2004/01/09 20:46:10 afe 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),istatus(MPI_STATUS_SIZE)
      INTEGER mpiBufSize,mpiRequest

C     Set dummy myThid value (we aren't 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	dimitri	1.2	C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_eeboot.F,v 1.1 2004/01/09 20:46:10 afe 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.2	INTEGER npe,itemp(nSx),istatus(MPI_STATUS_SIZE)
37			INTEGER mpiBufSize,mpiRequest
38	afe	1.1
39			C Set dummy myThid value (we aren't multi-threaded here)
40			myThid = 1
41
42			C Define toplogy for every tile
43			CALL W2_E2SETUP
44
45	dimitri	1.2	C Decide which tiles this process handles - do this inline for now, but
46	afe	1.1	C should go in subroutine.
47			C Total number of tiles should be divisible by nPx and nSx
48			C ( there is no two dimensional decomposition for W2 ) and
49			C number of tiles per process should be nSx
50			nt_check = NTILES/(nPx*nSx)
51			nt_check = nt_checknPxnSx
52			IF ( nt_check .NE. NTILES ) THEN
53			STOP
54			&'ERROR: W2_EEBOOT number of tiles is not divisible by nPx*nSx'
55			ENDIF
56			nt_perproc = NTILES/nPx
57			IF ( nt_perproc .NE. nSx ) THEN
58			STOP
59			&'ERROR: W2_EEBOOT tiles per process is not equal to nSx'
60			ENDIF
61			C Number of tiles I handle is nSx, range of tile numbers I handle
62			C depends on my rank.
63			#ifdef ALLOW_USE_MPI
64			thisPtileLo = myPid*nt_perproc+1
65			thisPtileHi = (myPid+1)*nt_perproc
66			#else
67			thisPtileLo = 1
68			thisPtileHi = nt_perproc
69			#endif
70			DO I=thisPtileLo, thisPtileHi
71			W2_myTileList(I-thisPtileLo+1)=I
72			ENDDO
73			iErr = 0
74
75			DO I=1,nSx
76			C Check tile sizes
77			myTileId = W2_myTileList(I)
78			tnx = exch2_tnx(myTileId)
79			tny = exch2_tny(myTileId)
80			IF ( tnx .NE. sNx ) THEN
81			WRITE(msgBuffer,'(A,I4,A,I4)')
82			& 'ERROR: S/R W2_EEBOOT Topology tnx=',
83			& tnx,
84			& ' is not equal to subgrid size sNx=',
85			& sNx
86			CALL PRINT_MESSAGE(msgBuffer,
87			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
88			iErr = iErr+1
89			ENDIF
90			IF ( tny .NE. sNy ) THEN
91			WRITE(msgBuffer,'(A,I4,A,I4,A,I4)')
92			& 'ERROR: S/R W2_EEBOOT Topology for tile ',myTileId,
93			& 'tny=',
94			& tny,
95			& ' is not equal to subgrid size sNy=',
96			& sNy
97			CALL PRINT_MESSAGE(msgBuffer,
98			& errorMessageUnit, SQUEEZE_RIGHT, 1 )
99			iErr = iErr+1
100			ENDIF
101			ENDDO
102			IF ( iErr .NE. 0 ) THEN
103			STOP 'ABNORMAL END: W2_EEBOOT'
104			ENDIF
105
106			C Set which rank processes "own" which tiles. This should probably
107			C be queried as part of some hand-shaking but for now we use the
108			C functiional relationship that was used above.
109			DO I=1,nTiles
110			pRank = (I-1)/nt_perproc
111			exch2_tProc(I) = pRank+1
112			ENDDO
113
114			WRITE(msgBuffer,'(A)') '===== W2 TILE TOPLOGY ====='
115			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
116			& SQUEEZE_BOTH,myThid)
117			DO I=1,nSx
118			myTileId = W2_myTileList(I)
119			WRITE(msgBuffer,'(A,I4)') ' TILE: ', myTileId
120			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
121			& SQUEEZE_RIGHT,myThid)
122			DO J=1,exch2_nNeighbours(myTileId)
123			commFlag = 'M'
124			DO II=1,nSx
125			IF ( W2_myTileList(II) .EQ. exch2_neighbourId(J,myTileId) )
126			& commFlag = 'P'
127			ENDDO
128			IF ( commFlag .EQ. 'M' ) THEN
129			WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
130			& ' NEIGHBOUR ',J,' = TILE ',
131			& exch2_neighbourId(J,myTileId), ' Comm = MSG',
132			& ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
133			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
134			& SQUEEZE_RIGHT,myThid)
135			ENDIF
136			IF ( commFlag .EQ. 'P' ) THEN
137			WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')
138			& ' NEIGHBOUR ',J,' = TILE ',
139			& exch2_neighbourId(J,myTileId), ' Comm = PUT',
140			& ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
141			CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
142			& SQUEEZE_RIGHT,myThid)
143			ENDIF
144			W2_myCommFlag(J,I) = commFlag
145			ENDDO
146			ENDDO
147	dimitri	1.2
148			C Fill in values for W2_mpi_myTileList
149			#ifdef ALLOW_USE_MPI
150			mpiBufSize=nSx
151			mpiRequest=0
152			DO npe = 0, numberOfProcs-1
153			CALL MPI_ISEND (W2_myTileList, mpiBufSize, MPI_INTEGER,
154			& npe, mpiMyId, MPI_COMM_MODEL, mpiRequest, ierr)
155			ENDDO
156			DO npe = 0, numberOfProcs-1
157			CALL MPI_RECV (itemp, mpiBufSize, MPI_INTEGER,
158			& npe, npe, MPI_COMM_MODEL, istatus, ierr)
159			DO I=1,nSx
160			W2_mpi_myTileList(npe+1,I)=itemp(I)
161			ENDDO
162			ENDDO
163			#else /* ALLOW_USE_MPI */
164			DO I=1,nSx
165			W2_mpi_myTileList(1,I)=W2_myTileList(I)
166			ENDDO
167			#endif /* ALLOW_USE_MPI */
168
169	afe	1.1	C Print out the topology communication schedule
170			CALL W2_PRINT_COMM_SEQUENCE
171			C
172			RETURN
173			END