/[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.11 by jmc, Tue May 12 19:40:32 2009 UTC revision 1.12 by jmc, Sun Jun 28 01:00:23 2009 UTC
# Line 42  c     INTEGER W2_oUnit Line 42  c     INTEGER W2_oUnit
42        INTEGER stdUnit, iLen        INTEGER stdUnit, iLen
43        CHARACTER commFlag        CHARACTER commFlag
44        INTEGER myTileId        INTEGER myTileId
45        INTEGER myThid, I, J, II, np, jp        INTEGER myThid, I, J, II
46          INTEGER np, jp, bi, bj
47        INTEGER iErr, tNx, tNy        INTEGER iErr, tNx, tNy
48    
49  C     Set dummy myThid value (we are not multi-threaded here)  C     Set dummy myThid value (we are not multi-threaded here)
# Line 120  C     Number of tiles I handle is nSx*nS Line 121  C     Number of tiles I handle is nSx*nS
121        DO I=1,nTiles        DO I=1,nTiles
122         IF ( exch2_myFace(I) .NE. 0 ) THEN         IF ( exch2_myFace(I) .NE. 0 ) THEN
123          np = 1 + J/nt_perProc          np = 1 + J/nt_perProc
124          jp = 1 + MOD(J,nt_perProc)          jp = MOD(J,nt_perProc)
125            bj = 1 + jp/nSx
126            bi = 1 + MOD(jp,nSx)
127          exch2_tProc(I) = np          exch2_tProc(I) = np
128          W2_procTileList(jp,np) = I          W2_procTileList(bi,bj,np) = I
129          IF ( np.EQ.thisProc ) W2_myTileList(jp) = I          IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I
130          J = J + 1          J = J + 1
131         ENDIF         ENDIF
132        ENDDO        ENDDO
# Line 134  C     Number of tiles I handle is nSx*nS Line 137  C     Number of tiles I handle is nSx*nS
137    
138  C--   Check tile sizes  C--   Check tile sizes
139        iErr = 0        iErr = 0
140        DO I=1,nSx        DO bj=1,nSy
141         myTileId = W2_myTileList(I)         DO bi=1,nSx
142         tNx = exch2_tNx(myTileId)          myTileId = W2_myTileList(bi,bj)
143         tNy = exch2_tNy(myTileId)          tNx = exch2_tNx(myTileId)
144         IF ( tNx .NE. sNx ) THEN          tNy = exch2_tNy(myTileId)
145          WRITE(msgBuf,'(3(A,I5))')          IF ( tNx .NE. sNx ) THEN
146             WRITE(msgBuf,'(3(A,I5))')
147       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
148       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
149           CALL PRINT_MESSAGE(msgBuf,           CALL PRINT_MESSAGE(msgBuf,
150       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
151           iErr = iErr+1           iErr = iErr+1
152         ENDIF          ENDIF
153         IF ( tNy .NE. sNy ) THEN          IF ( tNy .NE. sNy ) THEN
154          WRITE(msgBuf,'(3(A,I5))')           WRITE(msgBuf,'(3(A,I5))')
155       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
156       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
157           CALL PRINT_MESSAGE(msgBuf,           CALL PRINT_MESSAGE(msgBuf,
158       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
159           iErr = iErr+1           iErr = iErr+1
160         ENDIF          ENDIF
161           ENDDO
162        ENDDO        ENDDO
163        IF ( iErr .NE. 0 ) THEN        IF ( iErr .NE. 0 ) THEN
164         STOP 'ABNORMAL END: W2_EEBOOT'         STOP 'ABNORMAL END: W2_EEBOOT'
# Line 162  C--   Check tile sizes Line 167  C--   Check tile sizes
167  C--   Print tiles connection for this process and set myCommonFlag :  C--   Print tiles connection for this process and set myCommonFlag :
168        WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='        WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
169        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
170        DO I=1,nSx        DO bj=1,nSy
171         myTileId = W2_myTileList(I)         DO bi=1,nSx
172  c      WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId          myTileId = W2_myTileList(bi,bj)
173         WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,  c       WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId
174       &      ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)          WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,
175         CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )       &       ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
176         DO J=1,exch2_nNeighbours(myTileId)          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
177          commFlag = 'M'          DO J=1,exch2_nNeighbours(myTileId)
178          DO II=1,nSx           commFlag = 'M'
179           IF ( W2_myTileList(II) .EQ. exch2_neighbourId(J,myTileId) )           DO II=1,nSy
180       &    commFlag = 'P'            DO I=1,nSx
181              IF ( W2_myTileList(I,II).EQ.exch2_neighbourId(J,myTileId) )
182         &     commFlag = 'P'
183              ENDDO
184             ENDDO
185             IF ( commFlag .EQ. 'M' ) THEN
186              WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
187         &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
188         &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = MSG',
189         &    ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
190              CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
191             ENDIF
192             IF ( commFlag .EQ. 'P' ) THEN
193              WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
194         &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
195         &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
196         &    ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
197              CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
198             ENDIF
199             W2_myCommFlag(J,bi,bj) = commFlag
200          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=',exch2_tProc(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=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'  
          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )  
         ENDIF  
         W2_myCommFlag(J,I) = commFlag  
201         ENDDO         ENDDO
202        ENDDO        ENDDO
203    
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22