/[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.12 by cnh, Sun Feb 4 14:38:43 2001 UTC revision 1.15 by dimitri, Tue Feb 18 05:33:53 2003 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
4  CStartOfInterface  CBOP
5    
6    C     !ROUTINE: INI_PROCS
7    
8    C     !INTERFACE:
9        SUBROUTINE INI_PROCS        SUBROUTINE INI_PROCS
 C     /==========================================================\  
 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     \==========================================================/  
10        IMPLICIT NONE        IMPLICIT NONE
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
53        INTEGER mpiRC        INTEGER mpiRC
54        INTEGER mpiGridSpec(2)        INTEGER mpiGridSpec(2)
# Line 53  C                        units. Line 60  C                        units.
60        INTEGER elCount        INTEGER elCount
61        INTEGER elLen        INTEGER elLen
62        INTEGER elStride        INTEGER elStride
63    
64    C--   Variables needed for mpi gather scatter routines.
65          COMMON /GlobalLo/ mpi_myXGlobalLo, mpi_myYGlobalLo
66          INTEGER mpi_myXGlobalLo(nPx*nPy)
67          INTEGER mpi_myYGlobalLo(nPx*nPy)
68          INTEGER npe,itemp,ierr,istatus(MPI_STATUS_SIZE)
69    
70  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
71        INTEGER myThid        INTEGER myThid
72    CEOP
73    
74  C--   Default values set to single processor case  C--   Default values set to single processor case
75  C     pid[W-SE] are the MPI process id of the neighbor  C     pid[W-SE] are the MPI process id of the neighbor
# Line 167  C--    Get my location on the grid Line 182  C--    Get my location on the grid
182         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)         mpiYGlobalLo = 1 + sNy*nSy*(mpiPy)
183         myXGlobalLo  = mpiXGlobalLo         myXGlobalLo  = mpiXGlobalLo
184         myYGlobalLo  = mpiYGlobalLo         myYGlobalLo  = mpiYGlobalLo
185    
186    C--   To speed-up mpi gather and scatter routines, myXGlobalLo
187    C     and myYGlobalLo from each process are transferred to
188    C     a common block array.  This allows process 0 to know
189    C     the location of the domains controlled by each process.
190           DO npe = 0, numberOfProcs-1
191              CALL MPI_SEND (myXGlobalLo, 1, MPI_INTEGER,
192         &         npe, mpiMyId, MPI_COMM_MODEL, ierr)
193           ENDDO
194           DO npe = 0, numberOfProcs-1
195              CALL MPI_RECV (itemp, 1, MPI_INTEGER,
196         &         npe, npe, MPI_COMM_MODEL, istatus, ierr)
197              mpi_myXGlobalLo(npe+1) = itemp
198           ENDDO
199           DO npe = 0, numberOfProcs-1
200              CALL MPI_SEND (myYGlobalLo, 1, MPI_INTEGER,
201         &         npe, mpiMyId, MPI_COMM_MODEL, ierr)
202           ENDDO
203           DO npe = 0, numberOfProcs-1
204              CALL MPI_RECV (itemp, 1, MPI_INTEGER,
205         &         npe, npe, MPI_COMM_MODEL, istatus, ierr)
206              mpi_myYGlobalLo(npe+1) = itemp
207           ENDDO
208    
209         myPx = mpiPx+1         myPx = mpiPx+1
210         myPy = mpiPy+1         myPy = mpiPy+1
211  C--    Get MPI id for neighboring procs.  C--    Get MPI id for neighboring procs.
# Line 294  C      xFace (y=constant) for XY arrays Line 333  C      xFace (y=constant) for XY arrays
333         elCount   = sNy+OLy*2         elCount   = sNy+OLy*2
334         elLen     = OLx         elLen     = OLx
335         elStride  = arrElSep         elStride  = arrElSep
336    #ifdef TARGET_SGI
337           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL,
338         &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
339    #else
340         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL4,
341       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)       &                       mpiTypeXFaceBlock_xy_r4, mpiRC)
342    #endif
343         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
344          eeBootError = .TRUE.          eeBootError = .TRUE.
345          WRITE(msgBuffer,'(A,I5)')          WRITE(msgBuffer,'(A,I5)')
# Line 313  C      xFace (y=constant) for XY arrays Line 357  C      xFace (y=constant) for XY arrays
357         ENDIF         ENDIF
358    
359  C      xFace (y=constant) for XY arrays with real*8 declaration.  C      xFace (y=constant) for XY arrays with real*8 declaration.
360    #ifdef TARGET_SGI
361           CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_DOUBLE_PRECISION,
362         &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
363    #else
364         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,         CALL MPI_TYPE_VECTOR(elCount,elLen,elStride,MPI_REAL8,
365       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)       &                       mpiTypeXFaceBlock_xy_r8, mpiRC)
366    #endif
367         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
368          eeBootError = .TRUE.          eeBootError = .TRUE.
369          WRITE(msgBuffer,'(A,I5)')          WRITE(msgBuffer,'(A,I5)')
# Line 382  C--    yFace datatypes (north<-->south m Line 431  C--    yFace datatypes (north<-->south m
431  C--  C--
432  C      yFace (x=constant) for XY arrays with real*4 declaration  C      yFace (x=constant) for XY arrays with real*4 declaration
433         elCount  = OLy*(sNx+OLx*2)         elCount  = OLy*(sNx+OLx*2)
434    #ifdef TARGET_SGI
435           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL,
436         &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
437    #else
438         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL4,
439       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)       &                          mpiTypeYFaceBlock_xy_r4, mpiRC)
440    #endif
441         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
442          eeBootError = .TRUE.          eeBootError = .TRUE.
443          WRITE(msgBuffer,'(A,I5)')          WRITE(msgBuffer,'(A,I5)')
# Line 400  C      yFace (x=constant) for XY arrays Line 454  C      yFace (x=constant) for XY arrays
454          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
455         ENDIF         ENDIF
456  C      yFace (x=constant) for XY arrays with real*8 declaration  C      yFace (x=constant) for XY arrays with real*8 declaration
457    #ifdef TARGET_SGI
458           CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_DOUBLE_PRECISION,
459         &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
460    #else
461         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,         CALL MPI_TYPE_CONTIGUOUS(elCount,MPI_REAL8,
462       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)       &                          mpiTypeYFaceBlock_xy_r8, mpiRC)
463    #endif
464         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
465          eeBootError = .TRUE.          eeBootError = .TRUE.
466          WRITE(msgBuffer,'(A,I5)')          WRITE(msgBuffer,'(A,I5)')
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22