/[MITgcm]/MITgcm/eesupp/src/ini_procs.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/ini_procs.F

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

revision 1.3 by cnh, Thu Apr 23 20:56:54 1998 UTC revision 1.27 by jmc, Wed May 6 20:33:08 2009 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
4    CBOP
5    
6    C     !ROUTINE: INI_PROCS
7    
8  CStartOfInterface  C     !INTERFACE:
9        SUBROUTINE INI_PROCS        SUBROUTINE INI_PROCS
10  C     /==========================================================\        IMPLICIT NONE
 C     | SUBROUTINE INI_PROCS                                     |  
 C     | o Initialise multiple concurrent processes environment.  |  
 C     |==========================================================|  
 C     | Under MPI this routine calls various MPI service routines|  
 C     | that map the model grid to MPI processes. The information|  
 C     | is then stored in a common block for later use.          |  
 C     | Note: This routine can also be compiled with CPP         |  
 C     | directives set so that no multi-processing is initialise.|  
 C     | This is OK and should work fine.                         |  
 C     \==========================================================/  
11    
12    C     !DESCRIPTION:
13    C     *==========================================================*
14    C     | SUBROUTINE INI\_PROCS
15    C     | o Initialise multiple concurrent processes environment.
16    C     *==========================================================*
17    C     | Under MPI this routine calls various MPI service routines
18    C     | that map the model grid to MPI processes. The information
19    C     | is then stored in a common block for later use.
20    C     | Note: This routine can also be compiled with CPP
21    C     | directives set so that no multi-processing is initialise.
22    C     | This is OK and should work fine.
23    C     *==========================================================*
24    
25    C     !USES:
26  C     === Global data ===  C     === Global data ===
27  #include "SIZE.h"  #include "SIZE.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 CEndOfInterface  
30    
 C     === Local variables ===  
31  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
32  C     msgBuffer        - IO buffer  C     !FUNCTIONS:
33  C     myThid           - Dummy thread id  
34  C     mpiRC            - Error code reporting variable used  C     !LOCAL VARIABLES:
35  C                        with MPI.  C     === Local variables ===
36  C     mpiGridSpec      - No. of processes in X and Y.  C     msgBuffer        :: IO buffer
37  C     mpiPeriodicity   - Flag indicating XY priodicity to MPI.  C     myThid           :: Dummy thread id
38  C     arrElSize        - Size of an array element in bytes used  C     mpiRC            :: Error code reporting variable used
39  C                        to define MPI datatypes for communication  C                         with MPI.
40  C                        operations.  C     mpiGridSpec      :: No. of processes in X and Y.
41  C     arrElSep         - Separation in units of array elements between  C     mpiPeriodicity   :: Flag indicating XY priodicity to MPI.
42  C                        blocks to be communicated.  C     arrElSize        :: Size of an array element in bytes used
43  C     elCount          - No. of blocks that are associated with MPI  C                         to define MPI datatypes for communication
44  C                        datatype.  C                         operations.
45  C     elLen            - Length of an MPI datatype in terms of preexisting  C     arrElSep         :: Separation in units of array elements between
46  C                        datatype.  C                         blocks to be communicated.
47  C     elStride         - Distance between starting location of elements  C     elCount          :: No. of blocks that are associated with MPI
48  C                        in an MPI datatype - can be bytes of datatype  C                         datatype.
49  C                        units.  C     elLen            :: Length of an MPI datatype in terms of preexisting
50    C                         datatype.
51    C     elStride         :: Distance between starting location of elements
52    C                         in an MPI datatype - can be bytes of datatype
53    C                         units.
54        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuffer
       INTEGER myThid  
55        INTEGER mpiRC        INTEGER mpiRC
56        INTEGER mpiGridSpec(2)        INTEGER mpiGridSpec(2)
57        INTEGER mpiPeriodicity(2)        INTEGER mpiPeriodicity(2)
# Line 54  C                        units. Line 62  C                        units.
62        INTEGER elCount        INTEGER elCount
63        INTEGER elLen        INTEGER elLen
64        INTEGER elStride        INTEGER elStride
65          INTEGER npe,itemp(2),ierr,istatus(MPI_STATUS_SIZE)
66          INTEGER mpiBufSize,mpiRequest
67  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
68          INTEGER myThid
69    CEOP
70    
71  C--   Default values set to single processor case  C--   Default values set to single processor case
72  C     pid[W-SE] are the MPI process id's of the neighbor  C     pid[W-SE] are the MPI process id of the neighbor
73  C     processes. A process can be its own neighbor!  C     processes. A process can be its own neighbor!
74        pidW          = 1        myThid      = 1
75        pidE          = 1        myPid       = 1
76        pidN          = 1        nProcs      = 1
77        pidS          = 1        myPx        = 1
78        pidNW         = 1        myPy        = 1
79        pidNE         = 1        myXGlobalLo = 1
80        pidSW         = 1        myYGlobalLo = 1
81        pidSE         = 1        pidW        = 1
82        myPx          = 1        pidE        = 1
83        myPy          = 1        pidN        = 1
84        myXGlobalLo   = 1        pidS        = 1
85        myYGlobalLo   = 1  c     errorMessageUnit    = 0
86    c     standardMessageUnit = 6
87    
88  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
89  C--  C--
90  C--   MPI style full multiple-process initialisation  C--   MPI style full multiple-process initialisation
# Line 137  C      Could be periodic in X and/or Y - Line 151  C      Could be periodic in X and/or Y -
151  #endif /* CAN_PREVENT_Y_PERIODICITY */  #endif /* CAN_PREVENT_Y_PERIODICITY */
152    
153         CALL MPI_CART_CREATE(         CALL MPI_CART_CREATE(
154       I  MPI_COMM_WORLD,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,       I  MPI_COMM_MODEL,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,
155       O  mpiComm, mpiRC )       O  mpiComm, mpiRC )
156         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
157          eeBootError = .TRUE.          eeBootError = .TRUE.
158          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
159       &        'S/R INI_PROCS: MPI_CART_CREATE return code',       &        'S/R INI_PROCS: MPI_CART_CREATE return code',
160       &        mpiRC       &        mpiRC
161          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
162          GOTO 999          GOTO 999
163         ENDIF         ENDIF
# Line 152  C--    Get my location on the grid Line 166  C--    Get my location on the grid
166         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )
167         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
168          eeBootError = .TRUE.          eeBootError = .TRUE.
169          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
170       &        'S/R INI_PROCS: MPI_CART_COORDS return code',       &        'S/R INI_PROCS: MPI_CART_COORDS return code',
171       &        mpiRC       &        mpiRC
172          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
173          GOTO 999          GOTO 999
174         ENDIF         ENDIF
175           myPid = mpiMyId
176         mpiPx = mpiGridSpec(1)         mpiPx = mpiGridSpec(1)
177         mpiPy = mpiGridSpec(2)         mpiPy = mpiGridSpec(2)
178         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)
179         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)
180         myXGlobalLo  = mpiXGlobalLo         myXGlobalLo  = mpiXGlobalLo
181         myYGlobalLo  = mpiYGlobalLo         myYGlobalLo  = mpiYGlobalLo
182    
183    C--   To speed-up mpi gather and scatter routines, myXGlobalLo
184    C     and myYGlobalLo from each process are transferred to
185    C     a common block array.  This allows process 0 to know
186    C     the location of the domains controlled by each process.
187           DO npe = 0, numberOfProcs-1
188              itemp(1) = myXGlobalLo
189              itemp(2) = myYGlobalLo
190              CALL MPI_BCAST(itemp, 2, MPI_INTEGER, npe,
191         &         MPI_COMM_MODEL, ierr)
192              mpi_myXGlobalLo(npe+1) = itemp(1)
193              mpi_myYGlobalLo(npe+1) = itemp(2)
194           ENDDO
195    
196           myPx = mpiPx+1
197           myPy = mpiPy+1
198  C--    Get MPI id for neighboring procs.  C--    Get MPI id for neighboring procs.
199         mpiGridSpec(1) = mpiPx-1         mpiGridSpec(1) = mpiPx-1
200         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
201         &   .AND. mpiGridSpec(1) .LT. 0 )
202       &  mpiGridSpec(1) = nPx-1       &  mpiGridSpec(1) = nPx-1
203         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
204         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )
205         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
206          eeBootError = .TRUE.          eeBootError = .TRUE.
207          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
208       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',
209       &        mpiRC       &        mpiRC
210          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
211          GOTO 999          GOTO 999
212         ENDIF         ENDIF
213         pidW = mpiPidW         pidW = mpiPidW
214         mpiGridSpec(1) = mpiPx+1         mpiGridSpec(1) = mpiPx+1
215         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .GT. nPx-1 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
216         &   .AND. mpiGridSpec(1) .GT. nPx-1 )
217       &  mpiGridSpec(1) = 0       &  mpiGridSpec(1) = 0
218         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
219         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )
220         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
221          eeBootError = .TRUE.          eeBootError = .TRUE.
222          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
223       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',
224       &        mpiRC       &        mpiRC
225          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
226          GOTO 999          GOTO 999
227         ENDIF         ENDIF
228         pidE = mpiPidE         pidE = mpiPidE
229         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
230         mpiGridSpec(2) = mpiPy-1         mpiGridSpec(2) = mpiPy-1
231         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .LT. 0 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
232         &   .AND. mpiGridSpec(2) .LT. 0 )
233       &  mpiGridSpec(2) = nPy - 1       &  mpiGridSpec(2) = nPy - 1
234         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )
235         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
236          eeBootError = .TRUE.          eeBootError = .TRUE.
237          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
238       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',
239       &        mpiRC       &        mpiRC
240          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
241          GOTO 999          GOTO 999
242         ENDIF         ENDIF
243         pidS = mpiPidS         pidS = mpiPidS
244         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
245         mpiGridSpec(2) = mpiPy+1         mpiGridSpec(2) = mpiPy+1
246         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .GT. nPy-1 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
247         &   .AND. mpiGridSpec(2) .GT. nPy-1 )
248       &  mpiGridSpec(2) = 0       &  mpiGridSpec(2) = 0
249         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )
250         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
251          eeBootError = .TRUE.          eeBootError = .TRUE.
252          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
253       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',
254       &        mpiRC       &        mpiRC
255          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
256          GOTO 999          GOTO 999
257         ENDIF         ENDIF
258         pidN = mpiPidN         pidN = mpiPidN
        mpiGridSpec(1) = mpiPx-1  
        IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0 )  
      &  mpiGridSpec(1) = nPx - 1  
        mpiGridSpec(2) = mpiPy-1  
        IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .LT. 0 )  
      &  mpiGridSpec(2) = nPy - 1  
        CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidSW, mpiRC )  
        IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
         eeBootError = .TRUE.  
         WRITE(msgBuffer,'(A,I)')  
      &        'S/R INI_PROCS: MPI_CART_RANK (pidSW) return code',  
      &        mpiRC  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         GOTO 999  
        ENDIF  
        pidSW = mpiPidSW  
        mpiGridSpec(1) = mpiPx+1  
        IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .GT. nPx-1 )  
      &  mpiGridSpec(1) = 0  
        mpiGridSpec(2) = mpiPy-1  
        IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .LT. 0 )  
      &  mpiGridSpec(2) = nPy - 1  
        CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidSE, mpiRC )  
        IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
         eeBootError = .TRUE.  
         WRITE(msgBuffer,'(A,I)')  
      &        'S/R INI_PROCS: MPI_CART_RANK (pidSE) return code',  
      &        mpiRC  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         GOTO 999  
        ENDIF  
        pidSE = mpiPidSE  
        mpiGridSpec(1) = mpiPx-1  
        IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0     )  
      &  mpiGridSpec(1) = nPx-1  
        mpiGridSpec(2) = mpiPy+1  
        IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .GT. nPy-1 )  
      &  mpiGridSpec(2) = 0  
        CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidNW, mpiRC )  
        IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
         eeBootError = .TRUE.  
         WRITE(msgBuffer,'(A,I)')  
      &        'S/R INI_PROCS: MPI_CART_RANK (pidNW) return code',  
      &        mpiRC  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         GOTO 999  
        ENDIF  
        pidNW = mpiPidNW  
        mpiGridSpec(1) = mpiPx+1  
        IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0     )  
      &  mpiGridSpec(1) = nPx-1  
        mpiGridSpec(2) = mpiPy+1  
        IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .GT. nPy-1 )  
      &  mpiGridSpec(2) = 0  
        CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidNE, mpiRC )  
        IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
         eeBootError = .TRUE.  
         WRITE(msgBuffer,'(A,I)')  
      &        'S/R INI_PROCS: MPI_CART_RANK (pidNE) return code',  
      &        mpiRC  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         GOTO 999  
        ENDIF  
        pidNE = mpiPidNE  
259    
260  C--    Print summary of processor mapping on standard output  C--    Print summary of processor mapping on standard output
261         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )
262         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
263          eeBootError = .TRUE.          eeBootError = .TRUE.
264          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
265       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',
266       &        mpiRC       &        mpiRC
267          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
268          GOTO 999          GOTO 999
269         ENDIF         ENDIF
270         WRITE(msgBuffer,'(A)') '======= Starting MPI parallel Run ========='         WRITE(msgBuffer,'(A)')
271         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   '======= Starting MPI parallel Run ========='
272           CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
273       &  SQUEEZE_BOTH , myThid)       &  SQUEEZE_BOTH , myThid)
274         WRITE(msgBuffer,'(A,A64)') ' My Processor Name = ',         WRITE(msgBuffer,'(A,I3,A,A)') ' My Processor Name (len:',
275       &  mpiProcNam(1:mpilProcNam)       &  mpilProcNam, ' ) = ', mpiProcNam(1:mpilProcNam)
276         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
277       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
278         WRITE(msgBuffer,'(A,I3,A,I3,A,I3,A,I3,A)') ' Located at (',         WRITE(msgBuffer,'(A,I3,A,I3,A,I3,A,I3,A)') ' Located at (',
279       &  mpiPx,',',mpiPy,       &  mpiPx,',',mpiPy,
280       &  ') on processor grid (0:',nPx-1,',0:',nPy-1,')'       &  ') on processor grid (0:',nPx-1,',0:',nPy-1,')'
281         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
282       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
283         WRITE(msgBuffer,'(A,I4,A,I4,A,I4,A,I4,A)') ' Origin at  (',         WRITE(msgBuffer,'(A,I4,A,I4,A,I4,A,I4,A)') ' Origin at  (',
284       &  mpiXGlobalLo,',',mpiYGLobalLo,       &  mpiXGlobalLo,',',mpiYGLobalLo,
285       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'
286         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
287       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
288         WRITE(msgBuffer,'(A,I4.4)') ' North neighbor = processor ', mpiPidN         WRITE(msgBuffer,'(A,I4.4)')
289         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   ' North neighbor = processor ', mpiPidN
290       &  SQUEEZE_RIGHT , myThid)         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
291         WRITE(msgBuffer,'(A,I4.4)') ' South neighbor = processor ', mpiPidS       &  SQUEEZE_RIGHT , myThid)
292         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         WRITE(msgBuffer,'(A,I4.4)')
293       &  SQUEEZE_RIGHT , myThid)       &   ' South neighbor = processor ', mpiPidS
294         WRITE(msgBuffer,'(A,I4.4)') '  East neighbor = processor ', mpiPidE         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
295         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &  SQUEEZE_RIGHT , myThid)
296       &  SQUEEZE_RIGHT , myThid)         WRITE(msgBuffer,'(A,I4.4)')
297         WRITE(msgBuffer,'(A,I4.4)') '  West neighbor = processor ', mpiPidW       &   '  East neighbor = processor ', mpiPidE
298         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
299       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
300         WRITE(msgBuffer,'(A,I4.4)') '    NW neighbor = processor ', mpiPidNW         WRITE(msgBuffer,'(A,I4.4)')
301         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   '  West neighbor = processor ', mpiPidW
302       &  SQUEEZE_RIGHT , myThid)         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
        WRITE(msgBuffer,'(A,I4.4)') '    NE neighbor = processor ', mpiPidNE  
        CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,  
      &  SQUEEZE_RIGHT , myThid)  
        WRITE(msgBuffer,'(A,I4.4)') '    SW neighbor = processor ', mpiPidSW  
        CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,  
      &  SQUEEZE_RIGHT , myThid)  
        WRITE(msgBuffer,'(A,I4.4)') '    SE neighbor = processor ', mpiPidSE  
        CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,  
303       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
304  C  C
305  C--    Create MPI types for transfer of array edges.  C--    Create MPI types for transfer of array edges.
# Line 356  C      xFace (y=constant) for XY arrays Line 320  C      xFace (y=constant) for XY arrays
320         elCount   = sNy+OLy*2         elCount   = sNy+OLy*2
321         elLen     = OLx         elLen     = OLx
322         elStride  = arrElSep         elStride  = arrElSep
323    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
324           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL,
325         &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
326    #else
327         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,
328       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
329    #endif
330         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
331          eeBootError = .TRUE.          eeBootError = .TRUE.
332          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
333       &        'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r4)',
334       &        mpiRC       &        mpiRC
335          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
336         ENDIF         ENDIF
337         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)
338         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
339          eeBootError = .TRUE.          eeBootError = .TRUE.
340          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
341       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',
342       &        mpiRC       &        mpiRC
343          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
344         ENDIF         ENDIF
345    
346  C      xFace (y=constant) for XY arrays with real*8 declaration.  C      xFace (y=constant) for XY arrays with real*8 declaration.
347    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
348           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_DOUBLE_PRECISION,
349         &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
350    #else
351         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,
352       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
353    #endif
354         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
355          eeBootError = .TRUE.          eeBootError = .TRUE.
356          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
357       &        'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r8)',
358       &        mpiRC       &        mpiRC
359          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
360         ENDIF         ENDIF
361         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)
362         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
363          eeBootError = .TRUE.          eeBootError = .TRUE.
364          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
365       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',
366       &        mpiRC       &        mpiRC
367          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
368         ENDIF         ENDIF
369    
370  C      xFace (y=constant) for XYZ arrays with real*4 declaration.  C      xFace (y=constant) for XYZ arrays with real*4 declaration.
371         arrElSize = 4         arrElSize = 4
372         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
373         elCount   = Nz         elCount   = Nr
374         elLen     = 1         elLen     = 1
375         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
376         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 404  C      xFace (y=constant) for XYZ arrays Line 378  C      xFace (y=constant) for XYZ arrays
378       &                       mpiTypeXFaceBlock_xyz_r4, mpiRC)       &                       mpiTypeXFaceBlock_xyz_r4, mpiRC)
379         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
380          eeBootError = .TRUE.          eeBootError = .TRUE.
381          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
382       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',
383       &        mpiRC       &        mpiRC
384          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
385         ENDIF         ENDIF
386         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)
387         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
388          eeBootError = .TRUE.          eeBootError = .TRUE.
389          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
390       &        'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',
391       &        mpiRC       &        mpiRC
392          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
393         ENDIF         ENDIF
394    
# Line 426  C      xFace (y=constant) for XYZ arrays Line 400  C      xFace (y=constant) for XYZ arrays
400       &                       mpiTypeXFaceBlock_xyz_r8, mpiRC)       &                       mpiTypeXFaceBlock_xyz_r8, mpiRC)
401         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
402          eeBootError = .TRUE.          eeBootError = .TRUE.
403          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
404       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',
405       &        mpiRC       &        mpiRC
406          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
407         ENDIF         ENDIF
408         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)
409         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
410          eeBootError = .TRUE.          eeBootError = .TRUE.
411          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
412       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',
413       &        mpiRC       &        mpiRC
414          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
415         ENDIF         ENDIF
416  C--  C--
# Line 444  C--    yFace datatypes (north<-->south m Line 418  C--    yFace datatypes (north<-->south m
418  C--  C--
419  C      yFace (x=constant) for XY arrays with real*4 declaration  C      yFace (x=constant) for XY arrays with real*4 declaration
420         elCount  = OLy*(sNx+OLx*2)         elCount  = OLy*(sNx+OLx*2)
421    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
422           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL,
423         &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
424    #else
425         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,
426       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
427    #endif
428         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
429          eeBootError = .TRUE.          eeBootError = .TRUE.
430          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
431       &        'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',
432       &        mpiRC       &        mpiRC
433          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
434         ENDIF         ENDIF
435         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)
436         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
437          eeBootError = .TRUE.          eeBootError = .TRUE.
438          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
439       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',
440       &        mpiRC       &        mpiRC
441          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
442         ENDIF         ENDIF
443  C      yFace (x=constant) for XY arrays with real*8 declaration  C      yFace (x=constant) for XY arrays with real*8 declaration
444    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
445           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_DOUBLE_PRECISION,
446         &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
447    #else
448         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,
449       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
450    #endif
451         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
452          eeBootError = .TRUE.          eeBootError = .TRUE.
453          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
454       &        'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',
455       &        mpiRC       &        mpiRC
456          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
457         ENDIF         ENDIF
458         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)
459         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
460          eeBootError = .TRUE.          eeBootError = .TRUE.
461          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
462       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',
463       &        mpiRC       &        mpiRC
464          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
465         ENDIF         ENDIF
466  C      yFace (x=constant) for XYZ arrays with real*4 declaration  C      yFace (x=constant) for XYZ arrays with real*4 declaration
467         arrElSize = 4         arrElSize = 4
468         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
469         elCount   = Nz         elCount   = Nr
470         elLen     = 1         elLen     = 1
471         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
472         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 490  C      yFace (x=constant) for XYZ arrays Line 474  C      yFace (x=constant) for XYZ arrays
474       &                       mpiTypeYFaceBlock_xyz_r4, mpiRC)       &                       mpiTypeYFaceBlock_xyz_r4, mpiRC)
475         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
476          eeBootError = .TRUE.          eeBootError = .TRUE.
477          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
478       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',
479       &        mpiRC       &        mpiRC
480          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
481         ENDIF         ENDIF
482         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)
483         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
484          eeBootError = .TRUE.          eeBootError = .TRUE.
485          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
486       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',
487       &        mpiRC       &        mpiRC
488          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
489         ENDIF         ENDIF
490  C      yFace (x=constant) for XYZ arrays with real*8 declaration  C      yFace (x=constant) for XYZ arrays with real*8 declaration
# Line 511  C      yFace (x=constant) for XYZ arrays Line 495  C      yFace (x=constant) for XYZ arrays
495       &                       mpiTypeYFaceBlock_xyz_r8, mpiRC)       &                       mpiTypeYFaceBlock_xyz_r8, mpiRC)
496         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
497          eeBootError = .TRUE.          eeBootError = .TRUE.
498          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
499       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',
500       &        mpiRC       &        mpiRC
501          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
502         ENDIF         ENDIF
503         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)
504         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
505          eeBootError = .TRUE.          eeBootError = .TRUE.
506          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
507       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',
508       &        mpiRC       &        mpiRC
509          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
510         ENDIF         ENDIF
511    
# Line 530  C--    Assign MPI values used in generat Line 514  C--    Assign MPI values used in generat
514         mpiTagE    = 2         mpiTagE    = 2
515         mpiTagS    = 3         mpiTagS    = 3
516         mpiTagN    = 4         mpiTagN    = 4
        mpiTagSW   = 5  
        mpiTagSE   = 6  
        mpiTagNW   = 7  
        mpiTagNE   = 8  
517    
518  C  C
519         CALL MPI_Barrier(MPI_COMM_WORLD,mpiRC)         CALL MPI_Barrier(MPI_COMM_MODEL,mpiRC)
520    
521    
522  C  C
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22