/[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.2 by cnh, Thu Apr 23 20:37:30 1998 UTC revision 1.24 by heimbach, Wed Apr 16 20:46:46 2008 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    
31    C     !LOCAL VARIABLES:
32  C     === Local variables ===  C     === Local variables ===
33  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
34  C     msgBuffer        - IO buffer  C     msgBuffer        :: IO buffer
35  C     myThid           - Dummy thread id  C     myThid           :: Dummy thread id
36  C     mpiRC            - Error code reporting variable used  C     mpiRC            :: Error code reporting variable used
37  C                        with MPI.  C                         with MPI.
38  C     mpiGridSpec      - No. of processes in X and Y.  C     mpiGridSpec      :: No. of processes in X and Y.
39  C     mpiPeriodicity   - Flag indicating XY priodicity to MPI.  C     mpiPeriodicity   :: Flag indicating XY priodicity to MPI.
40  C     arrElSize        - Size of an array element in bytes used  C     arrElSize        :: Size of an array element in bytes used
41  C                        to define MPI datatypes for communication  C                         to define MPI datatypes for communication
42  C                        operations.  C                         operations.
43  C     arrElSep         - Separation in units of array elements between  C     arrElSep         :: Separation in units of array elements between
44  C                        blocks to be communicated.  C                         blocks to be communicated.
45  C     elCount          - No. of blocks that are associated with MPI  C     elCount          :: No. of blocks that are associated with MPI
46  C                        datatype.  C                         datatype.
47  C     elLen            - Length of an MPI datatype in terms of preexisting  C     elLen            :: Length of an MPI datatype in terms of preexisting
48  C                        datatype.  C                         datatype.
49  C     elStride         - Distance between starting location of elements  C     elStride         :: Distance between starting location of elements
50  C                        in an MPI datatype - can be bytes of datatype  C                         in an MPI datatype - can be bytes of datatype
51  C                        units.  C                         units.
52        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuffer
       INTEGER myThid  
53        INTEGER mpiRC        INTEGER mpiRC
54        INTEGER mpiGridSpec(2)        INTEGER mpiGridSpec(2)
55        INTEGER mpiPeriodicity(2)        INTEGER mpiPeriodicity(2)
# Line 54  C                        units. Line 60  C                        units.
60        INTEGER elCount        INTEGER elCount
61        INTEGER elLen        INTEGER elLen
62        INTEGER elStride        INTEGER elStride
63          INTEGER npe,itemp(2),ierr,istatus(MPI_STATUS_SIZE)
64          INTEGER mpiBufSize,mpiRequest
65  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
66          INTEGER myThid
67    CEOP
68    
69  C--   Default values set to single processor case  C--   Default values set to single processor case
70  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
71  C     processes. A process can be its own neighbor!  C     processes. A process can be its own neighbor!
72        pidW          = 1        myThid      = 1
73        pidE          = 1        myPid       = 1
74        pidN          = 1        nProcs      = 1
75        pidS          = 1        myPx        = 1
76        pidNW         = 1        myPy        = 1
77        pidNE         = 1        myXGlobalLo = 1
78        pidSW         = 1        myYGlobalLo = 1
79        pidSE         = 1        pidW        = 1
80        myPx          = 1        pidE        = 1
81        myPy          = 1        pidN        = 1
82        myXGlobalLo   = 1        pidS        = 1
83        myYGlobalLo   = 1  c     errorMessageUnit    = 0
84    c     standardMessageUnit = 6
85    
86  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
87  C--  C--
88  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 149  C      Could be periodic in X and/or Y -
149  #endif /* CAN_PREVENT_Y_PERIODICITY */  #endif /* CAN_PREVENT_Y_PERIODICITY */
150    
151         CALL MPI_CART_CREATE(         CALL MPI_CART_CREATE(
152       I  MPI_COMM_WORLD,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,       I  MPI_COMM_MODEL,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,
153       O  mpiComm, mpiRC )       O  mpiComm, mpiRC )
154         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
155          eeBootError = .TRUE.          eeBootError = .TRUE.
156          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
157       &        'S/R INI_PROCS: MPI_CART_CREATE return code',       &        'S/R INI_PROCS: MPI_CART_CREATE return code',
158       &        mpiRC       &        mpiRC
159          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 152  C--    Get my location on the grid Line 164  C--    Get my location on the grid
164         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )
165         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
166          eeBootError = .TRUE.          eeBootError = .TRUE.
167          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
168       &        'S/R INI_PROCS: MPI_CART_COORDS return code',       &        'S/R INI_PROCS: MPI_CART_COORDS return code',
169       &        mpiRC       &        mpiRC
170          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
171          GOTO 999          GOTO 999
172         ENDIF         ENDIF
173           myPid = mpiMyId
174         mpiPx = mpiGridSpec(1)         mpiPx = mpiGridSpec(1)
175         mpiPy = mpiGridSpec(2)         mpiPy = mpiGridSpec(2)
176         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)
177         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)
178         myXGlobalLo  = mpiXGlobalLo         myXGlobalLo  = mpiXGlobalLo
179         myYGlobalLo  = mpiYGlobalLo         myYGlobalLo  = mpiYGlobalLo
180    
181    C--   To speed-up mpi gather and scatter routines, myXGlobalLo
182    C     and myYGlobalLo from each process are transferred to
183    C     a common block array.  This allows process 0 to know
184    C     the location of the domains controlled by each process.
185           DO npe = 0, numberOfProcs-1
186              itemp(1) = myXGlobalLo
187              itemp(2) = myYGlobalLo
188              CALL MPI_BCAST(itemp, 2, MPI_INTEGER, npe,
189         &         MPI_COMM_MODEL, ierr)
190              mpi_myXGlobalLo(npe+1) = itemp(1)
191              mpi_myYGlobalLo(npe+1) = itemp(2)
192           ENDDO
193    
194           myPx = mpiPx+1
195           myPy = mpiPy+1
196  C--    Get MPI id for neighboring procs.  C--    Get MPI id for neighboring procs.
197         mpiGridSpec(1) = mpiPx-1         mpiGridSpec(1) = mpiPx-1
198         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
199         &   .AND. mpiGridSpec(1) .LT. 0 )
200       &  mpiGridSpec(1) = nPx-1       &  mpiGridSpec(1) = nPx-1
201         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
202         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )
203         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
204          eeBootError = .TRUE.          eeBootError = .TRUE.
205          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
206       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',
207       &        mpiRC       &        mpiRC
208          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 180  C--    Get MPI id for neighboring procs. Line 210  C--    Get MPI id for neighboring procs.
210         ENDIF         ENDIF
211         pidW = mpiPidW         pidW = mpiPidW
212         mpiGridSpec(1) = mpiPx+1         mpiGridSpec(1) = mpiPx+1
213         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .GT. nPx-1 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
214         &   .AND. mpiGridSpec(1) .GT. nPx-1 )
215       &  mpiGridSpec(1) = 0       &  mpiGridSpec(1) = 0
216         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
217         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )
218         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
219          eeBootError = .TRUE.          eeBootError = .TRUE.
220          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
221       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',
222       &        mpiRC       &        mpiRC
223          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 195  C--    Get MPI id for neighboring procs. Line 226  C--    Get MPI id for neighboring procs.
226         pidE = mpiPidE         pidE = mpiPidE
227         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
228         mpiGridSpec(2) = mpiPy-1         mpiGridSpec(2) = mpiPy-1
229         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .LT. 0 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
230         &   .AND. mpiGridSpec(2) .LT. 0 )
231       &  mpiGridSpec(2) = nPy - 1       &  mpiGridSpec(2) = nPy - 1
232         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )
233         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
234          eeBootError = .TRUE.          eeBootError = .TRUE.
235          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
236       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',
237       &        mpiRC       &        mpiRC
238          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 209  C--    Get MPI id for neighboring procs. Line 241  C--    Get MPI id for neighboring procs.
241         pidS = mpiPidS         pidS = mpiPidS
242         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
243         mpiGridSpec(2) = mpiPy+1         mpiGridSpec(2) = mpiPy+1
244         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .GT. nPy-1 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
245         &   .AND. mpiGridSpec(2) .GT. nPy-1 )
246       &  mpiGridSpec(2) = 0       &  mpiGridSpec(2) = 0
247         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )
248         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
249          eeBootError = .TRUE.          eeBootError = .TRUE.
250          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
251       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',
252       &        mpiRC       &        mpiRC
253          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
254          GOTO 999          GOTO 999
255         ENDIF         ENDIF
256         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  
257    
258  C--    Print summary of processor mapping on standard output  C--    Print summary of processor mapping on standard output
259         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )
260         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
261          eeBootError = .TRUE.          eeBootError = .TRUE.
262          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
263       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',
264       &        mpiRC       &        mpiRC
265          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
266          GOTO 999          GOTO 999
267         ENDIF         ENDIF
268         WRITE(msgBuffer,'(A)') '======= Starting MPI parallel Run ========='         WRITE(msgBuffer,'(A)')
269         &   '======= Starting MPI parallel Run ========='
270         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
271       &  SQUEEZE_BOTH , myThid)       &  SQUEEZE_BOTH , myThid)
272         WRITE(msgBuffer,'(A,A64)') ' My Processor Name = ',         WRITE(msgBuffer,'(A,A64)') ' My Processor Name = ',
# Line 313  C--    Print summary of processor mappin Line 283  C--    Print summary of processor mappin
283       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'
284         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
285       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
286         WRITE(msgBuffer,'(A,I4.4)') ' North neighbor = processor ', mpiPidN         WRITE(msgBuffer,'(A,I4.4)')
287         &   ' North neighbor = processor ', mpiPidN
288         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
289       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
290         WRITE(msgBuffer,'(A,I4.4)') ' South neighbor = processor ', mpiPidS         WRITE(msgBuffer,'(A,I4.4)')
291         &   ' South neighbor = processor ', mpiPidS
292         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
293       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
294         WRITE(msgBuffer,'(A,I4.4)') '  East neighbor = processor ', mpiPidE         WRITE(msgBuffer,'(A,I4.4)')
295         &   '  East neighbor = processor ', mpiPidE
296         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
297       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
298         WRITE(msgBuffer,'(A,I4.4)') '  West neighbor = processor ', mpiPidW         WRITE(msgBuffer,'(A,I4.4)')
299         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   '  West neighbor = processor ', mpiPidW
      &  SQUEEZE_RIGHT , myThid)  
        WRITE(msgBuffer,'(A,I4.4)') '    NW neighbor = processor ', mpiPidNW  
        CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,  
      &  SQUEEZE_RIGHT , myThid)  
        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  
300         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
301       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
302  C  C
# Line 356  C      xFace (y=constant) for XY arrays Line 318  C      xFace (y=constant) for XY arrays
318         elCount   = sNy+OLy*2         elCount   = sNy+OLy*2
319         elLen     = OLx         elLen     = OLx
320         elStride  = arrElSep         elStride  = arrElSep
321    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
322           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL,
323         &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
324    #else
325         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,
326       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
327    #endif
328         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
329          eeBootError = .TRUE.          eeBootError = .TRUE.
330          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
331       &        'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r4)',
332       &        mpiRC       &        mpiRC
333          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
334         ENDIF         ENDIF
335         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)
336         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
337          eeBootError = .TRUE.          eeBootError = .TRUE.
338          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
339       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',
340       &        mpiRC       &        mpiRC
341          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
342         ENDIF         ENDIF
343    
344  C      xFace (y=constant) for XY arrays with real*8 declaration.  C      xFace (y=constant) for XY arrays with real*8 declaration.
345    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
346           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_DOUBLE_PRECISION,
347         &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
348    #else
349         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,
350       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
351    #endif
352         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
353          eeBootError = .TRUE.          eeBootError = .TRUE.
354          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
355       &        'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r8)',
356       &        mpiRC       &        mpiRC
357          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
358         ENDIF         ENDIF
359         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)
360         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
361          eeBootError = .TRUE.          eeBootError = .TRUE.
362          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
363       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',
364       &        mpiRC       &        mpiRC
365          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
366         ENDIF         ENDIF
# Line 396  C      xFace (y=constant) for XY arrays Line 368  C      xFace (y=constant) for XY arrays
368  C      xFace (y=constant) for XYZ arrays with real*4 declaration.  C      xFace (y=constant) for XYZ arrays with real*4 declaration.
369         arrElSize = 4         arrElSize = 4
370         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
371         elCount   = Nz         elCount   = Nr
372         elLen     = 1         elLen     = 1
373         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
374         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 404  C      xFace (y=constant) for XYZ arrays Line 376  C      xFace (y=constant) for XYZ arrays
376       &                       mpiTypeXFaceBlock_xyz_r4, mpiRC)       &                       mpiTypeXFaceBlock_xyz_r4, mpiRC)
377         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
378          eeBootError = .TRUE.          eeBootError = .TRUE.
379          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
380       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',
381       &        mpiRC       &        mpiRC
382          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
383         ENDIF         ENDIF
384         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)
385         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
386          eeBootError = .TRUE.          eeBootError = .TRUE.
387          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
388       &        'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',
389       &        mpiRC       &        mpiRC
390          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
391         ENDIF         ENDIF
# Line 426  C      xFace (y=constant) for XYZ arrays Line 398  C      xFace (y=constant) for XYZ arrays
398       &                       mpiTypeXFaceBlock_xyz_r8, mpiRC)       &                       mpiTypeXFaceBlock_xyz_r8, mpiRC)
399         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
400          eeBootError = .TRUE.          eeBootError = .TRUE.
401          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
402       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',
403       &        mpiRC       &        mpiRC
404          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
405         ENDIF         ENDIF
406         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)
407         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
408          eeBootError = .TRUE.          eeBootError = .TRUE.
409          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
410       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',
411       &        mpiRC       &        mpiRC
412          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
413         ENDIF         ENDIF
# Line 444  C--    yFace datatypes (north<-->south m Line 416  C--    yFace datatypes (north<-->south m
416  C--  C--
417  C      yFace (x=constant) for XY arrays with real*4 declaration  C      yFace (x=constant) for XY arrays with real*4 declaration
418         elCount  = OLy*(sNx+OLx*2)         elCount  = OLy*(sNx+OLx*2)
419    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
420           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL,
421         &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
422    #else
423         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,
424       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
425    #endif
426         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
427          eeBootError = .TRUE.          eeBootError = .TRUE.
428          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
429       &        'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',
430       &        mpiRC       &        mpiRC
431          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
432         ENDIF         ENDIF
433         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)
434         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
435          eeBootError = .TRUE.          eeBootError = .TRUE.
436          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
437       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',
438       &        mpiRC       &        mpiRC
439          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
440         ENDIF         ENDIF
441  C      yFace (x=constant) for XY arrays with real*8 declaration  C      yFace (x=constant) for XY arrays with real*8 declaration
442    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
443           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_DOUBLE_PRECISION,
444         &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
445    #else
446         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,
447       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
448    #endif
449         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
450          eeBootError = .TRUE.          eeBootError = .TRUE.
451          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
452       &        'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',
453       &        mpiRC       &        mpiRC
454          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
455         ENDIF         ENDIF
456         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)
457         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
458          eeBootError = .TRUE.          eeBootError = .TRUE.
459          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
460       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',
461       &        mpiRC       &        mpiRC
462          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
463         ENDIF         ENDIF
464  C      yFace (x=constant) for XYZ arrays with real*4 declaration  C      yFace (x=constant) for XYZ arrays with real*4 declaration
465         arrElSize = 4         arrElSize = 4
466         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
467         elCount   = Nz         elCount   = Nr
468         elLen     = 1         elLen     = 1
469         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
470         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 490  C      yFace (x=constant) for XYZ arrays Line 472  C      yFace (x=constant) for XYZ arrays
472       &                       mpiTypeYFaceBlock_xyz_r4, mpiRC)       &                       mpiTypeYFaceBlock_xyz_r4, mpiRC)
473         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
474          eeBootError = .TRUE.          eeBootError = .TRUE.
475          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
476       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',
477       &        mpiRC       &        mpiRC
478          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
479         ENDIF         ENDIF
480         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)
481         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
482          eeBootError = .TRUE.          eeBootError = .TRUE.
483          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
484       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',
485       &        mpiRC       &        mpiRC
486          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
487         ENDIF         ENDIF
# Line 511  C      yFace (x=constant) for XYZ arrays Line 493  C      yFace (x=constant) for XYZ arrays
493       &                       mpiTypeYFaceBlock_xyz_r8, mpiRC)       &                       mpiTypeYFaceBlock_xyz_r8, mpiRC)
494         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
495          eeBootError = .TRUE.          eeBootError = .TRUE.
496          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
497       &        'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',
498       &        mpiRC       &        mpiRC
499          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
500         ENDIF         ENDIF
501         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)
502         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
503          eeBootError = .TRUE.          eeBootError = .TRUE.
504          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
505       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',
506       &        mpiRC       &        mpiRC
507          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
508         ENDIF         ENDIF
# Line 530  C--    Assign MPI values used in generat Line 512  C--    Assign MPI values used in generat
512         mpiTagE    = 2         mpiTagE    = 2
513         mpiTagS    = 3         mpiTagS    = 3
514         mpiTagN    = 4         mpiTagN    = 4
        mpiTagSW   = 5  
        mpiTagSE   = 6  
        mpiTagNW   = 7  
        mpiTagNE   = 8  
515    
516  C  C
517         CALL MPI_Barrier(MPI_COMM_WORLD,mpiRC)         CALL MPI_Barrier(MPI_COMM_MODEL,mpiRC)
518    
519    
520  C  C
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22