/[MITgcm]/MITgcm/pkg/exch2/w2_eeboot.F
ViewVC logotype

Diff of /MITgcm/pkg/exch2/w2_eeboot.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by dimitri, Tue Apr 6 00:25:56 2004 UTC revision 1.11 by jmc, Tue May 12 19:40:32 2009 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6  CBOP              CBOP
7  C     !ROUTINE: W2_EEBOOT  C     !ROUTINE: W2_EEBOOT
8    
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE W2_EEBOOT        SUBROUTINE W2_EEBOOT
       IMPLICIT NONE  
11    
12  C     !DESCRIPTION:  C     !DESCRIPTION:
13  C     *==========================================================*  C     *==========================================================*
14  C     | SUBROUTINE W2_EEBOOT                                          C     | SUBROUTINE W2_EEBOOT
15  C     | o Setup execution "environment" for WRAPPER2              C     | o Setup execution "environment" for WRAPPER2
16  C     *==========================================================*  C     *==========================================================*
17  C     | WRAPPER2 provides complex topology support. In this routine  C     | WRAPPER2 provides complex topology support. In this routine
18  C     | we setup the base topology for the default halo operations.  C     | we setup the base topology for the default halo operations.
19  C     *==========================================================*  C     *==========================================================*
20    
21    C     !USES:
22          IMPLICIT NONE
23    
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26  #include "EESUPPORT.h"  #include "EESUPPORT.h"
27    #include "W2_EXCH2_SIZE.h"
28  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
29  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
30    #include "W2_EXCH2_BUFFER.h"
31    CEOP
32    
33    C     !FUNCTIONS:
34          INTEGER  ILNBLNK
35          EXTERNAL ILNBLNK
36    
37  C     == Local variables ==  C     == Local variables ==
38        INTEGER nt_check, nt_perproc        INTEGER nt_perProc, thisProc
39        INTEGER thisPtileLo, thisPtileHi        CHARACTER*(MAX_LEN_MBUF) msgBuf
40        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_FNAM) fName
41    c     INTEGER W2_oUnit
42          INTEGER stdUnit, iLen
43        CHARACTER commFlag        CHARACTER commFlag
44        INTEGER myTileId        INTEGER myTileId
45        INTEGER myThid, I, J, II        INTEGER myThid, I, J, II, np, jp
46        INTEGER iErr, tNx, tNy        INTEGER iErr, tNx, tNy
       INTEGER pRank  
       INTEGER npe,itemp(nSx),istatus(MPI_STATUS_SIZE)  
       INTEGER mpiBufSize,mpiRequest  
47    
48  C     Set dummy myThid value (we aren't multi-threaded here)  C     Set dummy myThid value (we are not multi-threaded here)
49        myThid = 1        myThid = 1
50    
51  C     Define toplogy for every tile  C     Initialise to zero EXCH2_TOPOLOGY common blocks
52        CALL W2_E2SETUP        DO I = 1,W2_maxNbTiles
53            exch2_tNx(I)    = 0
54            exch2_tNy(I)    = 0
55            exch2_tBasex(I) = 0
56            exch2_tBasey(I) = 0
57            exch2_txGlobalo(I) = 0
58            exch2_tyGlobalo(I) = 0
59            exch2_isWedge(I) = 0
60            exch2_isNedge(I) = 0
61            exch2_isEedge(I) = 0
62            exch2_isSedge(I) = 0
63            exch2_tProc(I)   = 0
64            exch2_myFace(I)  = 0
65            exch2_mydNx(I)   = 0
66            exch2_mydNy(I)   = 0
67            exch2_nNeighbours(I) = 0
68            DO J = 1,W2_maxNeighbours
69              exch2_neighbourId(J,I)  = 0
70              exch2_opposingSend(J,I) = 0
71              DO II = 1,4
72               exch2_pij(II,J,I) = 0
73              ENDDO
74              exch2_oi(J,I)  = 0
75              exch2_oj(J,I)  = 0
76              exch2_iLo(J,I) = 0
77              exch2_iHi(J,I) = 0
78              exch2_jLo(J,I) = 0
79              exch2_jHi(J,I) = 0
80            ENDDO
81          ENDDO
82          W2_oUnit = standardMessageUnit
83    
84    C     Set W2-EXCH2 parameters
85          CALL W2_READPARMS( myThid )
86    
87          stdUnit = standardMessageUnit
88          WRITE(msgBuf,'(A)') '===== Start setting W2 TOPOLOGY:'
89          CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
90    
91    C     Open message output-file (if needed)
92          IF ( W2_printMsg .LT. 0 ) THEN
93            WRITE(fName,'(A,I4.4,A)')
94         &     'w2_tile_topology.',myProcId,'.log'
95            iLen = ILNBLNK(fName)
96            CALL MDSFINDUNIT( W2_oUnit, myThid )
97            OPEN( W2_oUnit, file=fName(1:iLen),
98         &                  status='unknown', form='formatted')
99            WRITE(msgBuf,'(2A)') ' write to log-file: ', fName(1:iLen)
100            CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
101          ENDIF
102    
103    C     Define topology for every tile
104          CALL W2_E2SETUP( myThid )
105    
106  C     Decide which tiles this process handles - do this inline for now, but  C     Decide which tiles this process handles - do this inline for now, but
107  C     should go in subroutine.  C     should go in subroutine.
108  C     Total number of tiles should be divisible by nPx and nSx  C     Set which rank processes "own" which tiles. This should probably
109  C     ( there is no two dimensional decomposition for W2 ) and  C     be queried as part of some hand-shaking but for now we use the
110  C     number of tiles per process should be nSx  C     functional relationship that was used above.
111        nt_check = NTILES/(nPx*nSx)  C     Fill also W2_procTileList for Single-CPU-IO.
112        nt_check = nt_check*nPx*nSx  
113        IF ( nt_check .NE. NTILES ) THEN  C     Number of tiles I handle is nSx*nSy
114        STOP        nt_perProc = nSx*nSy
115       &'ERROR: W2_EEBOOT number of tiles is not divisible by nPx*nSx'        thisProc = 1
       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.  
116  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
117        thisPtileLo = myPid*nt_perproc+1        thisProc = 1+myPid
       thisPtileHi = (myPid+1)*nt_perproc  
 #else  
       thisPtileLo = 1  
       thisPtileHi = nt_perproc  
118  #endif  #endif
119        DO I=thisPtileLo, thisPtileHi        J = 0
120         W2_myTileList(I-thisPtileLo+1)=I        DO I=1,nTiles
121           IF ( exch2_myFace(I) .NE. 0 ) THEN
122            np = 1 + J/nt_perProc
123            jp = 1 + MOD(J,nt_perProc)
124            exch2_tProc(I) = np
125            W2_procTileList(jp,np) = I
126            IF ( np.EQ.thisProc ) W2_myTileList(jp) = I
127            J = J + 1
128           ENDIF
129        ENDDO        ENDDO
130        iErr = 0        IF ( J .NE. nSx*nSy*nPx*nPy ) THEN
131           STOP
132         & 'ERROR W2_EEBOOT: number of active tiles is not nPx*nSx*nPy*nSy'
133          ENDIF
134    
135    C--   Check tile sizes
136          iErr = 0
137        DO I=1,nSx        DO I=1,nSx
 C      Check tile sizes  
138         myTileId = W2_myTileList(I)         myTileId = W2_myTileList(I)
139         tnx = exch2_tnx(myTileId)         tNx = exch2_tNx(myTileId)
140         tny = exch2_tny(myTileId)         tNy = exch2_tNy(myTileId)
141         IF ( tnx .NE. sNx ) THEN         IF ( tNx .NE. sNx ) THEN
142          WRITE(msgBuffer,'(A,I4,A,I4)')          WRITE(msgBuf,'(3(A,I5))')
143       &   'ERROR: S/R W2_EEBOOT Topology tnx=',       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
144       &   tnx,       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
145       &   ' is not equal to subgrid size sNx=',           CALL PRINT_MESSAGE(msgBuf,
      &   sNx  
          CALL PRINT_MESSAGE(msgBuffer,  
146       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
147           iErr = iErr+1           iErr = iErr+1
148         ENDIF         ENDIF
149         IF ( tny .NE. sNy ) THEN         IF ( tNy .NE. sNy ) THEN
150          WRITE(msgBuffer,'(A,I4,A,I4,A,I4)')          WRITE(msgBuf,'(3(A,I5))')
151       &   'ERROR: S/R W2_EEBOOT Topology for tile ',myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
152       &   'tny=',       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
153       &   tny,           CALL PRINT_MESSAGE(msgBuf,
      &   ' is not equal to subgrid size sNy=',  
      &   sNy  
          CALL PRINT_MESSAGE(msgBuffer,  
154       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
155           iErr = iErr+1           iErr = iErr+1
156         ENDIF         ENDIF
# Line 103  C      Check tile sizes Line 159  C      Check tile sizes
159         STOP 'ABNORMAL END: W2_EEBOOT'         STOP 'ABNORMAL END: W2_EEBOOT'
160        ENDIF        ENDIF
161    
162  C     Set which rank processes "own" which tiles. This should probably  C--   Print tiles connection for this process and set myCommonFlag :
163  C     be queried as part of some hand-shaking but for now we use the        WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
164  C     functiional relationship that was used above.        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
       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)  
165        DO I=1,nSx        DO I=1,nSx
166         myTileId = W2_myTileList(I)         myTileId = W2_myTileList(I)
167         WRITE(msgBuffer,'(A,I4)') ' TILE: ', myTileId  c      WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId
168         CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,         WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,
169       &      SQUEEZE_RIGHT,myThid)       &      ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
170           CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
171         DO J=1,exch2_nNeighbours(myTileId)         DO J=1,exch2_nNeighbours(myTileId)
172          commFlag = 'M'          commFlag = 'M'
173          DO II=1,nSx          DO II=1,nSx
# Line 126  C     functiional relationship that was Line 175  C     functiional relationship that was
175       &    commFlag = 'P'       &    commFlag = 'P'
176          ENDDO          ENDDO
177          IF ( commFlag .EQ. 'M' ) THEN          IF ( commFlag .EQ. 'M' ) THEN
178           WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')           WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
179       &   '      NEIGHBOUR ',J,' = TILE ',       &   '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
180       &   exch2_neighbourId(J,myTileId), ' Comm = MSG',       &   ' (n=', exch2_opposingSend(J,myTileId), ') Comm = MSG',
181       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'       &   ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
182           CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,           CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
      &        SQUEEZE_RIGHT,myThid)  
183          ENDIF          ENDIF
184          IF ( commFlag .EQ. 'P' ) THEN          IF ( commFlag .EQ. 'P' ) THEN
185           WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')           WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
186       &   '      NEIGHBOUR ',J,' = TILE ',       &   '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
187       &   exch2_neighbourId(J,myTileId), ' Comm = PUT',       &   ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
188       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'       &   ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
189           CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,           CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
      &        SQUEEZE_RIGHT,myThid)  
190          ENDIF          ENDIF
191          W2_myCommFlag(J,I) = commFlag          W2_myCommFlag(J,I) = commFlag
192         ENDDO         ENDDO
193        ENDDO        ENDDO
194    
195  C     Fill in values for W2_mpi_myTileList  C     Set filling value for face-corner halo regions
196  #ifdef ALLOW_USE_MPI        e2FillValue_RL = 0. _d 0
197        mpiBufSize=nSx        e2FillValue_RS = 0. _d 0
198        mpiRequest=0        e2FillValue_R4 = 0.e0
199        DO npe = 0, numberOfProcs-1        e2FillValue_R8 = 0.d0
200           CALL MPI_ISEND (W2_myTileList, mpiBufSize, MPI_INTEGER,  C-    for testing only: put a large value (should not affects the results)
201       &        npe, mpiMyId, MPI_COMM_MODEL, mpiRequest, ierr)  c     e2FillValue_RL = 1. _d+20
202        ENDDO  c     e2FillValue_RS = 1. _d+20
203        DO npe = 0, numberOfProcs-1  c     e2FillValue_R4 = 1.e+20
204           CALL MPI_RECV (itemp, mpiBufSize, MPI_INTEGER,  c     e2FillValue_R8 = 1.d+20
      &        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 */  
205    
206  C     Print out the topology communication schedule  C     Print out the topology communication schedule
207        CALL W2_PRINT_COMM_SEQUENCE        IF ( W2_printMsg .NE. 0 ) THEN
208  C          CALL W2_PRINT_COMM_SEQUENCE( myThid )
209          ENDIF
210    
211    C     Close message output-file (if needed)
212          IF ( W2_oUnit.NE.standardMessageUnit ) THEN
213            WRITE(msgBuf,'(A)') '===  End TOPOLOGY report ==='
214            CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
215            CLOSE( W2_oUnit )
216          ENDIF
217          WRITE(msgBuf,'(A)') '=====       setting W2 TOPOLOGY: Done'
218          CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
219          WRITE(msgBuf,'(A)') ' '
220          CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
221    
222        RETURN        RETURN
223        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22