/[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.6 by jmc, Sun Jul 24 01:24:56 2005 UTC revision 1.7 by jmc, Sat Apr 11 05:34:02 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_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
28  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
29    CEOP
30    
31  C     == Local variables ==  C     == Local variables ==
32        INTEGER nt_check, nt_perproc        INTEGER nt_perProc, thisProc
33        INTEGER thisPtileLo, thisPtileHi        CHARACTER*(MAX_LEN_MBUF) msgBuf
       CHARACTER*(MAX_LEN_MBUF) msgBuffer  
34        CHARACTER commFlag        CHARACTER commFlag
35        INTEGER myTileId        INTEGER myTileId
36        INTEGER myThid, I, J, II        INTEGER myThid, I, J, II, np, jp
37        INTEGER iErr, tNx, tNy        INTEGER iErr, tNx, tNy
38        INTEGER pRank        INTEGER pRank
 #ifdef ALLOW_USE_MPI  
       INTEGER npe,itemp(nSx),mpiBufSize,mpiRequest  
       INTEGER istatus(MPI_STATUS_SIZE)  
 #endif  
39    
40  C     Set dummy myThid value (we are not multi-threaded here)  C     Set dummy myThid value (we are not multi-threaded here)
41        myThid = 1        myThid = 1
42    
43  C     Define toplogy for every tile  C     Initialise to zero EXCH2_TOPOLOGY common blocks
44          DO I = 1,NTILES
45            exch2_tNx(I)    = 0
46            exch2_tNy(I)    = 0
47            exch2_tBasex(I) = 0
48            exch2_tBasey(I) = 0
49            exch2_txGlobalo(I) = 0
50            exch2_tyGlobalo(I) = 0
51            exch2_isWedge(I) = 0
52            exch2_isNedge(I) = 0
53            exch2_isEedge(I) = 0
54            exch2_isSedge(I) = 0
55            exch2_tProc(I)   = 0
56            exch2_myFace(I)  = 0
57            exch2_mydNx(I)   = 0
58            exch2_mydNy(I)   = 0
59            exch2_nNeighbours(I) = 0
60            DO J = 1,MAX_NEIGHBOURS
61              exch2_neighbourId(J,I)  = 0
62              exch2_opposingSend(J,I) = 0
63              DO II = 1,4
64               exch2_pij(II,J,I) = 0
65              ENDDO
66              exch2_oi(J,I)  = 0
67              exch2_oj(J,I)  = 0
68              exch2_iLo(J,I) = 0
69              exch2_iHi(J,I) = 0
70              exch2_jLo(J,I) = 0
71              exch2_jHi(J,I) = 0
72            ENDDO
73          ENDDO
74    
75    C     Define topology for every tile
76        CALL W2_E2SETUP        CALL W2_E2SETUP
77    
78  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
79  C     should go in subroutine.  C     should go in subroutine.
80  C     Total number of tiles should be divisible by nPx and nSx  C     Set which rank processes "own" which tiles. This should probably
81  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
82  C     number of tiles per process should be nSx  C     functional relationship that was used above.
83        nt_check = NTILES/(nPx*nSx)  C     Fill also W2_mpi_myTileList for Single-CPU-IO.
84        nt_check = nt_check*nPx*nSx  
85        IF ( nt_check .NE. NTILES ) THEN  C     Number of tiles I handle is nSx*nSy
86        STOP        nt_perProc = nSx*nSy
87       &'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.  
88  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
89        thisPtileLo = myPid*nt_perproc+1        thisProc = 1+myPid
       thisPtileHi = (myPid+1)*nt_perproc  
 #else  
       thisPtileLo = 1  
       thisPtileHi = nt_perproc  
90  #endif  #endif
91        DO I=thisPtileLo, thisPtileHi        J = 0
92         W2_myTileList(I-thisPtileLo+1)=I        DO I=1,NTILES
93           IF ( exch2_myFace(I) .NE. 0 ) THEN
94            np = 1 + J/nt_perProc
95            jp = 1 + MOD(J,nt_perProc)
96            exch2_tProc(I) = np
97            W2_mpi_myTileList(np,jp) = I
98            IF ( np.EQ.thisProc ) W2_myTileList(jp) = I
99            J = J + 1
100           ENDIF
101        ENDDO        ENDDO
102        iErr = 0        IF ( J .NE. nSx*nSy*nPx*nPy ) THEN
103           STOP
104         & 'ERROR W2_EEBOOT: number of active tiles is not nPx*nSx*nPy*nSy'
105          ENDIF
106    
107    C--   Check tile sizes
108          iErr = 0
109        DO I=1,nSx        DO I=1,nSx
 C      Check tile sizes  
110         myTileId = W2_myTileList(I)         myTileId = W2_myTileList(I)
111         tnx = exch2_tnx(myTileId)         tNx = exch2_tNx(myTileId)
112         tny = exch2_tny(myTileId)         tNy = exch2_tNy(myTileId)
113         IF ( tnx .NE. sNx ) THEN         IF ( tNx .NE. sNx ) THEN
114          WRITE(msgBuffer,'(A,I4,A,I4)')          WRITE(msgBuf,'(3(A,I5))')
115       &   'ERROR: S/R W2_EEBOOT Topology tnx=',       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
116       &   tnx,       &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
117       &   ' is not equal to subgrid size sNx=',           CALL PRINT_MESSAGE(msgBuf,
      &   sNx  
          CALL PRINT_MESSAGE(msgBuffer,  
118       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
119           iErr = iErr+1           iErr = iErr+1
120         ENDIF         ENDIF
121         IF ( tny .NE. sNy ) THEN         IF ( tNy .NE. sNy ) THEN
122          WRITE(msgBuffer,'(A,I4,A,I4,A,I4)')          WRITE(msgBuf,'(3(A,I5))')
123       &   'ERROR: S/R W2_EEBOOT Topology for tile ',myTileId,       &   'ERROR: S/R W2_EEBOOT Topology for tile', myTileId,
124       &   'tny=',       &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
125       &   tny,           CALL PRINT_MESSAGE(msgBuf,
      &   ' is not equal to subgrid size sNy=',  
      &   sNy  
          CALL PRINT_MESSAGE(msgBuffer,  
126       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )       &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
127           iErr = iErr+1           iErr = iErr+1
128         ENDIF         ENDIF
# Line 105  C      Check tile sizes Line 131  C      Check tile sizes
131         STOP 'ABNORMAL END: W2_EEBOOT'         STOP 'ABNORMAL END: W2_EEBOOT'
132        ENDIF        ENDIF
133    
134  C     Set which rank processes "own" which tiles. This should probably  C--   Print tiles connection for this process and set myCommonFlag :
135  C     be queried as part of some hand-shaking but for now we use the        WRITE(msgBuf,'(A)') '===== W2 TILE TOPLOGY ====='
136  C     functiional relationship that was used above.        CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
       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,  
137       &     SQUEEZE_BOTH,myThid)       &     SQUEEZE_BOTH,myThid)
138        DO I=1,nSx        DO I=1,nSx
139         myTileId = W2_myTileList(I)         myTileId = W2_myTileList(I)
140         WRITE(msgBuffer,'(A,I4)') ' TILE: ', myTileId         WRITE(msgBuf,'(A,I4)') ' TILE: ', myTileId
141         CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
142       &      SQUEEZE_RIGHT,myThid)       &      SQUEEZE_RIGHT,myThid)
143         DO J=1,exch2_nNeighbours(myTileId)         DO J=1,exch2_nNeighbours(myTileId)
144          commFlag = 'M'          commFlag = 'M'
# Line 128  C     functiional relationship that was Line 147  C     functiional relationship that was
147       &    commFlag = 'P'       &    commFlag = 'P'
148          ENDDO          ENDDO
149          IF ( commFlag .EQ. 'M' ) THEN          IF ( commFlag .EQ. 'M' ) THEN
150           WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')           WRITE(msgBuf,'(A,I4,A,I4,A,A,I4,A)')
151       &   '      NEIGHBOUR ',J,' = TILE ',       &   '      NEIGHBOUR ',J,' = TILE ',
152       &   exch2_neighbourId(J,myTileId), ' Comm = MSG',       &   exch2_neighbourId(J,myTileId), ' Comm = MSG',
153       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
154           CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
155       &        SQUEEZE_RIGHT,myThid)       &        SQUEEZE_RIGHT,myThid)
156          ENDIF          ENDIF
157          IF ( commFlag .EQ. 'P' ) THEN          IF ( commFlag .EQ. 'P' ) THEN
158           WRITE(msgBuffer,'(A,I4,A,I4,A,A,I4,A)')           WRITE(msgBuf,'(A,I4,A,I4,A,A,I4,A)')
159       &   '      NEIGHBOUR ',J,' = TILE ',       &   '      NEIGHBOUR ',J,' = TILE ',
160       &   exch2_neighbourId(J,myTileId), ' Comm = PUT',       &   exch2_neighbourId(J,myTileId), ' Comm = PUT',
161       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'       &   ' ( PROC = ',exch2_tProc(exch2_neighbourId(J,myTileId)),')'
162           CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
163       &        SQUEEZE_RIGHT,myThid)       &        SQUEEZE_RIGHT,myThid)
164          ENDIF          ENDIF
165          W2_myCommFlag(J,I) = commFlag          W2_myCommFlag(J,I) = commFlag
166         ENDDO         ENDDO
167        ENDDO        ENDDO
168    
 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 */  
   
169  C     Set filling value for face-corner halo regions  C     Set filling value for face-corner halo regions
170        e2FillValue_RL = 0. _d 0        e2FillValue_RL = 0. _d 0
171        e2FillValue_RS = 0. _d 0        e2FillValue_RS = 0. _d 0
# Line 181  c     e2FillValue_R8 = 1.d+20 Line 179  c     e2FillValue_R8 = 1.d+20
179    
180  C     Print out the topology communication schedule  C     Print out the topology communication schedule
181        CALL W2_PRINT_COMM_SEQUENCE        CALL W2_PRINT_COMM_SEQUENCE
182  C  
183        RETURN        RETURN
184        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22