/[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.9 by jmc, Wed Apr 29 21:37:46 2009 UTC revision 1.14 by jmc, Sat Jul 9 21:52:34 2011 UTC
# Line 23  C     !USES: Line 23  C     !USES:
23    
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26  #include "EESUPPORT.h"  #include "W2_EXCH2_SIZE.h"
27  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
28  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
29    #include "W2_EXCH2_BUFFER.h"
30  CEOP  CEOP
31    
32  C     !FUNCTIONS:  C     !FUNCTIONS:
# Line 33  C     !FUNCTIONS: Line 34  C     !FUNCTIONS:
34        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
35    
36  C     == Local variables ==  C     == Local variables ==
37        INTEGER nt_perProc, thisProc        INTEGER thisProc
38        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
39        CHARACTER*(MAX_LEN_FNAM) fName        CHARACTER*(MAX_LEN_FNAM) fName
40        INTEGER stdUnit, W2_oUnit, iLen  c     INTEGER W2_oUnit
41          INTEGER stdUnit, iLen
42        CHARACTER commFlag        CHARACTER commFlag
43        INTEGER myTileId        INTEGER myTileId
44        INTEGER myThid, I, J, II, np, jp        INTEGER myThid, I, J
45          INTEGER np, ii, jj, bi, bj
46        INTEGER iErr, tNx, tNy        INTEGER iErr, tNx, tNy
47    
48  C     Set dummy myThid value (we are not multi-threaded here)  C     Set dummy myThid value (we are not multi-threaded here)
49        myThid = 1        myThid = 1
50    
51  C     Initialise to zero EXCH2_TOPOLOGY common blocks  C     Initialise to zero EXCH2_TOPOLOGY common blocks
52        DO I = 1,NTILES        exch2_nTiles = 0
53          DO I = 1,W2_maxNbTiles
54          exch2_tNx(I)    = 0          exch2_tNx(I)    = 0
55          exch2_tNy(I)    = 0          exch2_tNy(I)    = 0
56          exch2_tBasex(I) = 0          exch2_tBasex(I) = 0
# Line 62  C     Initialise to zero EXCH2_TOPOLOGY Line 66  C     Initialise to zero EXCH2_TOPOLOGY
66          exch2_mydNx(I)   = 0          exch2_mydNx(I)   = 0
67          exch2_mydNy(I)   = 0          exch2_mydNy(I)   = 0
68          exch2_nNeighbours(I) = 0          exch2_nNeighbours(I) = 0
69          DO J = 1,MAX_NEIGHBOURS          DO J = 1,W2_maxNeighbours
70            exch2_neighbourId(J,I)  = 0            exch2_neighbourId(J,I)  = 0
71            exch2_opposingSend(J,I) = 0            exch2_opposingSend(J,I) = 0
72            DO II = 1,4            DO ii = 1,4
73             exch2_pij(II,J,I) = 0             exch2_pij(ii,J,I) = 0
74            ENDDO            ENDDO
75            exch2_oi(J,I)  = 0            exch2_oi(J,I)  = 0
76            exch2_oj(J,I)  = 0            exch2_oj(J,I)  = 0
# Line 76  C     Initialise to zero EXCH2_TOPOLOGY Line 80  C     Initialise to zero EXCH2_TOPOLOGY
80            exch2_jHi(J,I) = 0            exch2_jHi(J,I) = 0
81          ENDDO          ENDDO
82        ENDDO        ENDDO
 C     Initialise parameters from EXCH2_PARAMS common blocks  
83        W2_oUnit = standardMessageUnit        W2_oUnit = standardMessageUnit
84    
85  C     Set W2-EXCH2 parameters  C     Set W2-EXCH2 parameters
86  c     CALL W2_EXCH2_READPARMS        CALL W2_READPARMS( myThid )
 c     W2_oUnit = -1  
87    
88        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
89        WRITE(msgBuf,'(A)') '===== Start setting W2 TOPOLOGY:'        WRITE(msgBuf,'(A)') '===== Start setting W2 TOPOLOGY:'
90        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
91    
92  C     Open message output-file (if needed)  C     Open message output-file (if needed)
93        IF ( W2_oUnit.LT.0 ) THEN        IF ( W2_printMsg .LT. 0 ) THEN
94          WRITE(fName,'(A,I4.4,A)')          WRITE(fName,'(A,I4.4,A)')
95       &     'w2_tile_topology.',myProcId,'.log'       &     'w2_tile_topology.',myProcId,'.log'
96          iLen = ILNBLNK(fName)          iLen = ILNBLNK(fName)
# Line 100  C     Open message output-file (if neede Line 102  C     Open message output-file (if neede
102        ENDIF        ENDIF
103    
104  C     Define topology for every tile  C     Define topology for every tile
105        CALL W2_E2SETUP        CALL W2_E2SETUP( myThid )
106    
107  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
108  C     should go in subroutine.  C     should go in subroutine.
109  C     Set which rank processes "own" which tiles. This should probably  C     Set which rank processes "own" which tiles. This should probably
110  C     be queried as part of some hand-shaking but for now we use the  C     be queried as part of some hand-shaking but for now we use the
111  C     functional relationship that was used above.  C     functional relationship that was used above.
112  C     Fill also W2_mpi_myTileList for Single-CPU-IO.  C     Fill also W2_procTileList for Single-CPU-IO.
113    
114  C     Number of tiles I handle is nSx*nSy  C     Number of tiles I handle is nSx*nSy
115        nt_perProc = nSx*nSy        thisProc = 1 + myProcId
       thisProc = 1  
 #ifdef ALLOW_USE_MPI  
       thisProc = 1+myPid  
 #endif  
116        J = 0        J = 0
117        DO I=1,NTILES        DO I=1,exch2_nTiles
118         IF ( exch2_myFace(I) .NE. 0 ) THEN         IF ( exch2_myFace(I) .NE. 0 ) THEN
119          np = 1 + J/nt_perProc  C--   old ordering (makes no difference if nSy*nPy=1 )
120          jp = 1 + MOD(J,nt_perProc)  c       np = 1 + J/(nSx*nSy)
121    c       jj = MOD(J,nSx*nSy)
122    c       bj = 1 + jj/nSx
123    c       bi = 1 + MOD(jj,nSx)
124    C--   new ordering: for single sub-domain (nFacets=1) case, match default setting
125            jj = J/(nSx*nPx)
126            ii = MOD(J,nSx*nPx)
127    C--   natural way to order processors:
128    c       np = 1 + ii/nSx + (jj/nSy)*nPx
129    C--   switch processor order to match MPI_CART set-up
130            np = 1 + jj/nSy + (ii/nSx)*nPy
131            bj = 1 + MOD(jj,nSy)
132            bi = 1 + MOD(ii,nSx)
133    C--
134          exch2_tProc(I) = np          exch2_tProc(I) = np
135          W2_mpi_myTileList(np,jp) = I          W2_procTileList(bi,bj,np) = I
136          IF ( np.EQ.thisProc ) W2_myTileList(jp) = I          IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I
137          J = J + 1          J = J + 1
138         ENDIF         ENDIF
139        ENDDO        ENDDO
# Line 133  C     Number of tiles I handle is nSx*nS Line 144  C     Number of tiles I handle is nSx*nS
144    
145  C--   Check tile sizes  C--   Check tile sizes
146        iErr = 0        iErr = 0
147        DO I=1,nSx        DO bj=1,nSy
148         myTileId = W2_myTileList(I)         DO bi=1,nSx
149         tNx = exch2_tNx(myTileId)          myTileId = W2_myTileList(bi,bj)
150         tNy = exch2_tNy(myTileId)          tNx = exch2_tNx(myTileId)
151         IF ( tNx .NE. sNx ) THEN          tNy = exch2_tNy(myTileId)
152          WRITE(msgBuf,'(3(A,I5))')          IF ( tNx .NE. sNx ) THEN
153             WRITE(msgBuf,'(3(A,I5))')
154       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
155       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
156           CALL PRINT_MESSAGE(msgBuf,           CALL PRINT_MESSAGE(msgBuf,
157       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
158           iErr = iErr+1           iErr = iErr+1
159         ENDIF          ENDIF
160         IF ( tNy .NE. sNy ) THEN          IF ( tNy .NE. sNy ) THEN
161          WRITE(msgBuf,'(3(A,I5))')           WRITE(msgBuf,'(3(A,I5))')
162       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
163       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
164           CALL PRINT_MESSAGE(msgBuf,           CALL PRINT_MESSAGE(msgBuf,
165       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
166           iErr = iErr+1           iErr = iErr+1
167         ENDIF          ENDIF
168           ENDDO
169        ENDDO        ENDDO
170        IF ( iErr .NE. 0 ) THEN        IF ( iErr .NE. 0 ) THEN
171         STOP 'ABNORMAL END: W2_EEBOOT'         STOP 'ABNORMAL END: W2_EEBOOT'
# Line 161  C--   Check tile sizes Line 174  C--   Check tile sizes
174  C--   Print tiles connection for this process and set myCommonFlag :  C--   Print tiles connection for this process and set myCommonFlag :
175        WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='        WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
176        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
177        DO I=1,nSx        DO bj=1,nSy
178         myTileId = W2_myTileList(I)         DO bi=1,nSx
179         WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId          myTileId = W2_myTileList(bi,bj)
180         CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )  c       WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId
181         DO J=1,exch2_nNeighbours(myTileId)          WRITE(msgBuf,'(A,I5,A,I3)') ' TILE: ', myTileId,
182          commFlag = 'M'       &       ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
183          DO II=1,nSx          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
184           IF ( W2_myTileList(II) .EQ. exch2_neighbourId(J,myTileId) )          DO J=1,exch2_nNeighbours(myTileId)
185       &    commFlag = 'P'           commFlag = 'M'
186             DO jj=1,nSy
187              DO ii=1,nSx
188              IF ( W2_myTileList(ii,jj).EQ.exch2_neighbourId(J,myTileId) )
189         &     commFlag = 'P'
190              ENDDO
191             ENDDO
192             IF ( commFlag .EQ. 'M' ) 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 = MSG',
196         &    ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
197              CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
198             ENDIF
199             IF ( commFlag .EQ. 'P' ) THEN
200              WRITE(msgBuf,'(A,I3,A,I5,A,I3,2A,I5,A)')
201         &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
202         &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
203         &    ' (PROC=',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
204              CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
205             ENDIF
206             W2_myCommFlag(J,bi,bj) = commFlag
207          ENDDO          ENDDO
         IF ( commFlag .EQ. 'M' ) THEN  
          WRITE(msgBuf,'(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( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )  
         ENDIF  
         IF ( commFlag .EQ. 'P' ) THEN  
          WRITE(msgBuf,'(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( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )  
         ENDIF  
         W2_myCommFlag(J,I) = commFlag  
208         ENDDO         ENDDO
209        ENDDO        ENDDO
210    
# Line 201  c     e2FillValue_R4 = 1.e+20 Line 220  c     e2FillValue_R4 = 1.e+20
220  c     e2FillValue_R8 = 1.d+20  c     e2FillValue_R8 = 1.d+20
221    
222  C     Print out the topology communication schedule  C     Print out the topology communication schedule
223        CALL W2_PRINT_COMM_SEQUENCE( W2_oUnit )        IF ( W2_printMsg .NE. 0 ) THEN
224            CALL W2_PRINT_COMM_SEQUENCE( myThid )
225          ENDIF
226    
227  C     Close message output-file (if needed)  C     Close message output-file (if needed)
228        IF ( W2_oUnit.NE.standardMessageUnit ) THEN        IF ( W2_oUnit.NE.standardMessageUnit ) THEN
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22