/[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.25 by jmc, Tue Apr 28 15:18:57 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        INTEGER  IFNBLNK, ILNBLNK
34  C     mpiRC            - Error code reporting variable used        EXTERNAL IFNBLNK
35  C                        with MPI.        EXTERNAL ILNBLNK
36  C     mpiGridSpec      - No. of processes in X and Y.  
37  C     mpiPeriodicity   - Flag indicating XY priodicity to MPI.  C     !LOCAL VARIABLES:
38  C     arrElSize        - Size of an array element in bytes used  C     === Local variables ===
39  C                        to define MPI datatypes for communication  C     msgBuffer        :: IO buffer
40  C                        operations.  C     myThid           :: Dummy thread id
41  C     arrElSep         - Separation in units of array elements between  C     mpiRC            :: Error code reporting variable used
42  C                        blocks to be communicated.  C                         with MPI.
43  C     elCount          - No. of blocks that are associated with MPI  C     mpiGridSpec      :: No. of processes in X and Y.
44  C                        datatype.  C     mpiPeriodicity   :: Flag indicating XY priodicity to MPI.
45  C     elLen            - Length of an MPI datatype in terms of preexisting  C     arrElSize        :: Size of an array element in bytes used
46  C                        datatype.  C                         to define MPI datatypes for communication
47  C     elStride         - Distance between starting location of elements  C                         operations.
48  C                        in an MPI datatype - can be bytes of datatype  C     arrElSep         :: Separation in units of array elements between
49  C                        units.  C                         blocks to be communicated.
50    C     elCount          :: No. of blocks that are associated with MPI
51    C                         datatype.
52    C     elLen            :: Length of an MPI datatype in terms of preexisting
53    C                         datatype.
54    C     elStride         :: Distance between starting location of elements
55    C                         in an MPI datatype - can be bytes of datatype
56    C                         units.
57        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuffer
       INTEGER myThid  
58        INTEGER mpiRC        INTEGER mpiRC
59        INTEGER mpiGridSpec(2)        INTEGER mpiGridSpec(2)
60        INTEGER mpiPeriodicity(2)        INTEGER mpiPeriodicity(2)
61        INTEGER mpiLProcNam        INTEGER mpiLProcNam
62        CHARACTER*(MPI_MAX_PROCESSOR_NAME) mpiProcNam        CHARACTER*(MPI_MAX_PROCESSOR_NAME) mpiProcNam
63          INTEGER i1, i2
64        INTEGER arrElSize        INTEGER arrElSize
65        INTEGER arrElSep        INTEGER arrElSep
66        INTEGER elCount        INTEGER elCount
67        INTEGER elLen        INTEGER elLen
68        INTEGER elStride        INTEGER elStride
69          INTEGER npe,itemp(2),ierr,istatus(MPI_STATUS_SIZE)
70          INTEGER mpiBufSize,mpiRequest
71  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
72          INTEGER myThid
73    CEOP
74    
75  C--   Default values set to single processor case  C--   Default values set to single processor case
76  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
77  C     processes. A process can be its own neighbor!  C     processes. A process can be its own neighbor!
78        pidW          = 1        myThid      = 1
79        pidE          = 1        myPid       = 1
80        pidN          = 1        nProcs      = 1
81        pidS          = 1        myPx        = 1
82        pidNW         = 1        myPy        = 1
83        pidNE         = 1        myXGlobalLo = 1
84        pidSW         = 1        myYGlobalLo = 1
85        pidSE         = 1        pidW        = 1
86        myPx          = 1        pidE        = 1
87        myPy          = 1        pidN        = 1
88        myXGlobalLo   = 1        pidS        = 1
89        myYGlobalLo   = 1  c     errorMessageUnit    = 0
90    c     standardMessageUnit = 6
91    
92  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
93  C--  C--
94  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 155  C      Could be periodic in X and/or Y -
155  #endif /* CAN_PREVENT_Y_PERIODICITY */  #endif /* CAN_PREVENT_Y_PERIODICITY */
156    
157         CALL MPI_CART_CREATE(         CALL MPI_CART_CREATE(
158       I  MPI_COMM_WORLD,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,       I  MPI_COMM_MODEL,2,mpiGridSpec,mpiPeriodicity,_mpiTRUE_,
159       O  mpiComm, mpiRC )       O  mpiComm, mpiRC )
160         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
161          eeBootError = .TRUE.          eeBootError = .TRUE.
162          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
163       &        'S/R INI_PROCS: MPI_CART_CREATE return code',       &        'S/R INI_PROCS: MPI_CART_CREATE return code',
164       &        mpiRC       &        mpiRC
165          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
166          GOTO 999          GOTO 999
167         ENDIF         ENDIF
# Line 152  C--    Get my location on the grid Line 170  C--    Get my location on the grid
170         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )         CALL MPI_CART_COORDS( mpiComm, mpiMyId, 2, mpiGridSpec, mpiRC )
171         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
172          eeBootError = .TRUE.          eeBootError = .TRUE.
173          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
174       &        'S/R INI_PROCS: MPI_CART_COORDS return code',       &        'S/R INI_PROCS: MPI_CART_COORDS return code',
175       &        mpiRC       &        mpiRC
176          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
177          GOTO 999          GOTO 999
178         ENDIF         ENDIF
179           myPid = mpiMyId
180         mpiPx = mpiGridSpec(1)         mpiPx = mpiGridSpec(1)
181         mpiPy = mpiGridSpec(2)         mpiPy = mpiGridSpec(2)
182         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)         mpiXGlobalLo = 1 + sNx*nSx*(mpiPx)
183         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)
184         myXGlobalLo  = mpiXGlobalLo         myXGlobalLo  = mpiXGlobalLo
185         myYGlobalLo  = mpiYGlobalLo         myYGlobalLo  = mpiYGlobalLo
186    
187    C--   To speed-up mpi gather and scatter routines, myXGlobalLo
188    C     and myYGlobalLo from each process are transferred to
189    C     a common block array.  This allows process 0 to know
190    C     the location of the domains controlled by each process.
191           DO npe = 0, numberOfProcs-1
192              itemp(1) = myXGlobalLo
193              itemp(2) = myYGlobalLo
194              CALL MPI_BCAST(itemp, 2, MPI_INTEGER, npe,
195         &         MPI_COMM_MODEL, ierr)
196              mpi_myXGlobalLo(npe+1) = itemp(1)
197              mpi_myYGlobalLo(npe+1) = itemp(2)
198           ENDDO
199    
200           myPx = mpiPx+1
201           myPy = mpiPy+1
202  C--    Get MPI id for neighboring procs.  C--    Get MPI id for neighboring procs.
203         mpiGridSpec(1) = mpiPx-1         mpiGridSpec(1) = mpiPx-1
204         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .LT. 0 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
205         &   .AND. mpiGridSpec(1) .LT. 0 )
206       &  mpiGridSpec(1) = nPx-1       &  mpiGridSpec(1) = nPx-1
207         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
208         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidW , mpiRC )
209         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
210          eeBootError = .TRUE.          eeBootError = .TRUE.
211          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
212       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidW) return code',
213       &        mpiRC       &        mpiRC
214          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
215          GOTO 999          GOTO 999
216         ENDIF         ENDIF
217         pidW = mpiPidW         pidW = mpiPidW
218         mpiGridSpec(1) = mpiPx+1         mpiGridSpec(1) = mpiPx+1
219         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_ .AND. mpiGridSpec(1) .GT. nPx-1 )         IF ( mpiPeriodicity(1) .EQ. _mpiTRUE_
220         &   .AND. mpiGridSpec(1) .GT. nPx-1 )
221       &  mpiGridSpec(1) = 0       &  mpiGridSpec(1) = 0
222         mpiGridSpec(2) = mpiPy         mpiGridSpec(2) = mpiPy
223         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidE , mpiRC )
224         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
225          eeBootError = .TRUE.          eeBootError = .TRUE.
226          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
227       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidE) return code',
228       &        mpiRC       &        mpiRC
229          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
230          GOTO 999          GOTO 999
231         ENDIF         ENDIF
232         pidE = mpiPidE         pidE = mpiPidE
233         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
234         mpiGridSpec(2) = mpiPy-1         mpiGridSpec(2) = mpiPy-1
235         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .LT. 0 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
236         &   .AND. mpiGridSpec(2) .LT. 0 )
237       &  mpiGridSpec(2) = nPy - 1       &  mpiGridSpec(2) = nPy - 1
238         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidS , mpiRC )
239         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
240          eeBootError = .TRUE.          eeBootError = .TRUE.
241          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
242       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidS) return code',
243       &        mpiRC       &        mpiRC
244          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
245          GOTO 999          GOTO 999
246         ENDIF         ENDIF
247         pidS = mpiPidS         pidS = mpiPidS
248         mpiGridSpec(1) = mpiPx         mpiGridSpec(1) = mpiPx
249         mpiGridSpec(2) = mpiPy+1         mpiGridSpec(2) = mpiPy+1
250         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_ .AND. mpiGridSpec(2) .GT. nPy-1 )         IF ( mpiPeriodicity(2) .EQ. _mpiTRUE_
251         &   .AND. mpiGridSpec(2) .GT. nPy-1 )
252       &  mpiGridSpec(2) = 0       &  mpiGridSpec(2) = 0
253         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )         CALL MPI_CART_RANK( mpiComm, mpiGridSpec, mpiPidN , mpiRC )
254         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
255          eeBootError = .TRUE.          eeBootError = .TRUE.
256          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
257       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',       &        'S/R INI_PROCS: MPI_CART_RANK (pidN) return code',
258       &        mpiRC       &        mpiRC
259          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
260          GOTO 999          GOTO 999
261         ENDIF         ENDIF
262         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  
263    
264  C--    Print summary of processor mapping on standard output  C--    Print summary of processor mapping on standard output
265         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )         CALL MPI_GET_PROCESSOR_NAME( mpiProcNam, mpilProcNam, mpiRC )
266         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
267          eeBootError = .TRUE.          eeBootError = .TRUE.
268          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
269       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',       &        'S/R INI_PROCS: MPI_GET_PROCESSOR_NAME return code',
270       &        mpiRC       &        mpiRC
271          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
272          GOTO 999          GOTO 999
273         ENDIF         ENDIF
274         WRITE(msgBuffer,'(A)') '======= Starting MPI parallel Run ========='         WRITE(msgBuffer,'(A)')
275         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   '======= Starting MPI parallel Run ========='
276           CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
277       &  SQUEEZE_BOTH , myThid)       &  SQUEEZE_BOTH , myThid)
278         WRITE(msgBuffer,'(A,A64)') ' My Processor Name = ',         i1 = IFNBLNK(mpiProcNam)
279       &  mpiProcNam(1:mpilProcNam)         i2 = ILNBLNK(mpiProcNam)
280         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         WRITE(msgBuffer,'(A,I3,A,A)') ' My Processor Name (len:',
281         &  mpilProcNam, ' ) = ', mpiProcNam(i1:i2)
282           CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
283       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
284         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 (',
285       &  mpiPx,',',mpiPy,       &  mpiPx,',',mpiPy,
286       &  ') on processor grid (0:',nPx-1,',0:',nPy-1,')'       &  ') on processor grid (0:',nPx-1,',0:',nPy-1,')'
287         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
288       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
289         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  (',
290       &  mpiXGlobalLo,',',mpiYGLobalLo,       &  mpiXGlobalLo,',',mpiYGLobalLo,
291       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'       &  ') on global grid (1:',nPx*sNx*nSx,',1:',nPy*sNy*nSy,')'
292         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
293       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
294         WRITE(msgBuffer,'(A,I4.4)') ' North neighbor = processor ', mpiPidN         WRITE(msgBuffer,'(A,I4.4)')
295         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   ' North neighbor = processor ', mpiPidN
296       &  SQUEEZE_RIGHT , myThid)         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
297         WRITE(msgBuffer,'(A,I4.4)') ' South neighbor = processor ', mpiPidS       &  SQUEEZE_RIGHT , myThid)
298         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         WRITE(msgBuffer,'(A,I4.4)')
299       &  SQUEEZE_RIGHT , myThid)       &   ' South neighbor = processor ', mpiPidS
300         WRITE(msgBuffer,'(A,I4.4)') '  East neighbor = processor ', mpiPidE         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
301         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &  SQUEEZE_RIGHT , myThid)
302       &  SQUEEZE_RIGHT , myThid)         WRITE(msgBuffer,'(A,I4.4)')
303         WRITE(msgBuffer,'(A,I4.4)') '  West neighbor = processor ', mpiPidW       &   '  East neighbor = processor ', mpiPidE
304         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,
305       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
306         WRITE(msgBuffer,'(A,I4.4)') '    NW neighbor = processor ', mpiPidNW         WRITE(msgBuffer,'(A,I4.4)')
307         CALL PRINT_MESSAGE( msgBuffer, standardMessageUnit,       &   '  West neighbor = processor ', mpiPidW
308       &  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,  
309       &  SQUEEZE_RIGHT , myThid)       &  SQUEEZE_RIGHT , myThid)
310  C  C
311  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 326  C      xFace (y=constant) for XY arrays
326         elCount   = sNy+OLy*2         elCount   = sNy+OLy*2
327         elLen     = OLx         elLen     = OLx
328         elStride  = arrElSep         elStride  = arrElSep
329    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
330           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL,
331         &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
332    #else
333         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,
334       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
335    #endif
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_VECTOR (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r4)',
340       &        mpiRC       &        mpiRC
341          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
342         ENDIF         ENDIF
343         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r4, mpiRC)
344         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
345          eeBootError = .TRUE.          eeBootError = .TRUE.
346          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
347       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r4)',
348       &        mpiRC       &        mpiRC
349          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
350         ENDIF         ENDIF
351    
352  C      xFace (y=constant) for XY arrays with real*8 declaration.  C      xFace (y=constant) for XY arrays with real*8 declaration.
353    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
354           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_DOUBLE_PRECISION,
355         &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
356    #else
357         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,
358       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
359    #endif
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_VECTOR (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_VECTOR (mpiTypeXFaceBlock_xy_r8)',
364       &        mpiRC       &        mpiRC
365          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
366         ENDIF         ENDIF
367         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xy_r8, mpiRC)
368         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
369          eeBootError = .TRUE.          eeBootError = .TRUE.
370          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
371       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xy_r8)',
372       &        mpiRC       &        mpiRC
373          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
374         ENDIF         ENDIF
375    
376  C      xFace (y=constant) for XYZ arrays with real*4 declaration.  C      xFace (y=constant) for XYZ arrays with real*4 declaration.
377         arrElSize = 4         arrElSize = 4
378         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
379         elCount   = Nz         elCount   = Nr
380         elLen     = 1         elLen     = 1
381         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
382         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 404  C      xFace (y=constant) for XYZ arrays Line 384  C      xFace (y=constant) for XYZ arrays
384       &                       mpiTypeXFaceBlock_xyz_r4, mpiRC)       &                       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_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r4)',
389       &        mpiRC       &        mpiRC
390          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
391         ENDIF         ENDIF
392         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r4, mpiRC)
393         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
394          eeBootError = .TRUE.          eeBootError = .TRUE.
395          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
396       &        'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT  (mpiTypeXFaceBlock_xyz_r4)',
397       &        mpiRC       &        mpiRC
398          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
399         ENDIF         ENDIF
400    
# Line 426  C      xFace (y=constant) for XYZ arrays Line 406  C      xFace (y=constant) for XYZ arrays
406       &                       mpiTypeXFaceBlock_xyz_r8, mpiRC)       &                       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_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeXFaceBlock_xyz_r8)',
411       &        mpiRC       &        mpiRC
412          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
413         ENDIF         ENDIF
414         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeXFaceBlock_xyz_r8, mpiRC)
415         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
416          eeBootError = .TRUE.          eeBootError = .TRUE.
417          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
418       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeXFaceBlock_xyz_r8)',
419       &        mpiRC       &        mpiRC
420          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
421         ENDIF         ENDIF
422  C--  C--
# Line 444  C--    yFace datatypes (north<-->south m Line 424  C--    yFace datatypes (north<-->south m
424  C--  C--
425  C      yFace (x=constant) for XY arrays with real*4 declaration  C      yFace (x=constant) for XY arrays with real*4 declaration
426         elCount  = OLy*(sNx+OLx*2)         elCount  = OLy*(sNx+OLx*2)
427    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
428           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL,
429         &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
430    #else
431         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,
432       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
433    #endif
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_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r4)',
438       &        mpiRC       &        mpiRC
439          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
440         ENDIF         ENDIF
441         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r4, mpiRC)
442         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
443          eeBootError = .TRUE.          eeBootError = .TRUE.
444          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
445       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r4)',
446       &        mpiRC       &        mpiRC
447          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
448         ENDIF         ENDIF
449  C      yFace (x=constant) for XY arrays with real*8 declaration  C      yFace (x=constant) for XY arrays with real*8 declaration
450    #if (defined (TARGET_SGI) || defined (TARGET_AIX) || defined(TARGET_LAM))
451           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_DOUBLE_PRECISION,
452         &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
453    #else
454         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,
455       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
456    #endif
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_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_CONTIGUOUS (mpiTypeYFaceBlock_xy_r8)',
461       &        mpiRC       &        mpiRC
462          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
463         ENDIF         ENDIF
464         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xy_r8, mpiRC)
465         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
466          eeBootError = .TRUE.          eeBootError = .TRUE.
467          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
468       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xy_r8)',
469       &        mpiRC       &        mpiRC
470          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
471         ENDIF         ENDIF
472  C      yFace (x=constant) for XYZ arrays with real*4 declaration  C      yFace (x=constant) for XYZ arrays with real*4 declaration
473         arrElSize = 4         arrElSize = 4
474         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)
475         elCount   = Nz         elCount   = Nr
476         elLen     = 1         elLen     = 1
477         elStride  = arrElSize*arrElSep         elStride  = arrElSize*arrElSep
478         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,
# Line 490  C      yFace (x=constant) for XYZ arrays Line 480  C      yFace (x=constant) for XYZ arrays
480       &                       mpiTypeYFaceBlock_xyz_r4, mpiRC)       &                       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_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r4)',
485       &        mpiRC       &        mpiRC
486          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
487         ENDIF         ENDIF
488         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r4, mpiRC)
489         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
490          eeBootError = .TRUE.          eeBootError = .TRUE.
491          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
492       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r4)',
493       &        mpiRC       &        mpiRC
494          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
495         ENDIF         ENDIF
496  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 501  C      yFace (x=constant) for XYZ arrays
501       &                       mpiTypeYFaceBlock_xyz_r8, mpiRC)       &                       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_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_HVECTOR (mpiTypeYFaceBlock_xyz_r8)',
506       &        mpiRC       &        mpiRC
507          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
508         ENDIF         ENDIF
509         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)         CALL MPI_TYPE_COMMIT( mpiTypeYFaceBlock_xyz_r8, mpiRC)
510         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
511          eeBootError = .TRUE.          eeBootError = .TRUE.
512          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
513       &        'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',       &   'S/R INI_PROCS: MPI_TYPE_COMMIT (mpiTypeYFaceBlock_xyz_r8)',
514       &        mpiRC       &        mpiRC
515          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
516         ENDIF         ENDIF
517    
# Line 530  C--    Assign MPI values used in generat Line 520  C--    Assign MPI values used in generat
520         mpiTagE    = 2         mpiTagE    = 2
521         mpiTagS    = 3         mpiTagS    = 3
522         mpiTagN    = 4         mpiTagN    = 4
        mpiTagSW   = 5  
        mpiTagSE   = 6  
        mpiTagNW   = 7  
        mpiTagNE   = 8  
523    
524  C  C
525         CALL MPI_Barrier(MPI_COMM_WORLD,mpiRC)         CALL MPI_Barrier(MPI_COMM_MODEL,mpiRC)
526    
527    
528  C  C
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22