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

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

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

revision 1.4 by cnh, Sat Aug 22 17:51:06 1998 UTC revision 1.5 by cnh, Tue Sep 29 18:50:56 1998 UTC
# Line 8  C     /================================= Line 8  C     /=================================
8  C     | SUBROUTINE INI_THREADING_ENVIRONMENT                     |  C     | SUBROUTINE INI_THREADING_ENVIRONMENT                     |
9  C     | o Initialise multi-threaded environment.                 |  C     | o Initialise multi-threaded environment.                 |
10  C     |==========================================================|  C     |==========================================================|
11  C     | Generally we do not start separate threads here but      |  C     | Generally we do not start separate threads here.         |
12  C     | just initialise data structures indicating which of the  |  C     | The separate threads a spawned at later on.              |
13  C     | nSx x nSy blocks a thread is responsible for.            |  C     | Here we perform initialisation of data-structures        |
14    C     | that indicate which of the nSx x nSy tiles a thread is   |
15    C     | responsible for.                                         |
16  C     | The multiple threads are spawned in the top level MAIN   |  C     | The multiple threads are spawned in the top level MAIN   |
17  C     | routine.                                                 |  C     | routine.                                                 |
18  C     \==========================================================/  C     \==========================================================/
# Line 35  C                   j index, byHi is the Line 37  C                   j index, byHi is the
37  C     I, J        - Loop counter  C     I, J        - Loop counter
38  C     msgBuf      - I/O buffer for reporting status information.  C     msgBuf      - I/O buffer for reporting status information.
39  C     myThid      - Dummy thread id for use in printed messages  C     myThid      - Dummy thread id for use in printed messages
40  C                   ( this routine "INI_THREADING_ENVIRONMENT" is called before  C                   ( this routine "INI_THREADING_ENVIRONMENT" is
41  C                     multi-threading has started.)  C                     called before multi-threading has started.)
 C     threadWest  - Temporaries used in calculating neighbor threads.  
 C     threadEast      
 C     threadSouth  
 C     threadNorth  
42        INTEGER bxPerThread        INTEGER bxPerThread
43        INTEGER byPerThread        INTEGER byPerThread
44        INTEGER Thid        INTEGER Thid
45        INTEGER bxLo, bxHi        INTEGER bxLo, bxHi
46        INTEGER byLo, byHi        INTEGER byLo, byHi
47        INTEGER I, J        INTEGER I, J, nT
48        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
49        INTEGER myThid        INTEGER myThid
       INTEGER threadWest  
       INTEGER threadEast  
       INTEGER threadSouth  
       INTEGER threadNorth  
       INTEGER threadNW    
       INTEGER threadNE    
       INTEGER threadSW      
       INTEGER threadSE      
   
 #ifdef ALLOW_USE_MPI  
 C     elCount   - Length in elements of an MPI datatype  
 C     elStride  - Stride between elements of an MPI datatype.  
 C     elLen     - Length of each element of the datatype  
 C     arrElSize - Size in bytes of an array element  
 C     arrElSep  - Separation in array elements between consecutive  
 C                 start locations for an MPI datatype.  
 C     mpiRC     - MPI return code  
       INTEGER elCount  
       INTEGER elStride  
       INTEGER elLen  
       INTEGER arrElSize  
       INTEGER arrElSep  
       INTEGER mpiRC  
 #endif /* ALLOW_USE_MPI */  
50    
51  C--   Set default for all threads of having no blocks to  C--   Set default for all threads of having no blocks to
52  C--   work on - except for thread 1.  C--   work on - except for thread 1.
# Line 82  C--   work on - except for thread 1. Line 56  C--   work on - except for thread 1.
56        myByHi(1) = nSy        myByHi(1) = nSy
57        DO I = 2, MAX_NO_THREADS        DO I = 2, MAX_NO_THREADS
58         myBxLo(I) = 0         myBxLo(I) = 0
59         myBxHi(I) = 1         myBxHi(I) = 0
60         myByLo(I) = 0         myByLo(I) = 0
61         myByHi(I) = 1         myByHi(I) = 0
62        ENDDO        ENDDO
63        myThid = 1        myThid = 1
64          commName(COMM_NONE) = 'none'
65          commName(COMM_MSG ) = 'messages'
66          commName(COMM_PUT ) = 'put'
67          commName(COMM_GET ) = 'get'
68    
69  C--   If there are multiple threads allocate different range of the  C--   If there are multiple threads allocate different range of the
70  C--   nSx*nSy blocks to each thread.  C--   nSx*nSy blocks to each thread.
# Line 95  C     no. blocks nSy = m*nTy ( where m a Line 73  C     no. blocks nSy = m*nTy ( where m a
73  C     is handled by simply mapping threads to blocks in sequence  C     is handled by simply mapping threads to blocks in sequence
74  C     with the x thread index moving fastest.  C     with the x thread index moving fastest.
75  C     Later code which sets the thread number of neighboring blocks  C     Later code which sets the thread number of neighboring blocks
76  C     needs to be consisten with the code here.  C     needs to be consistent with the code here.
77        nThreads = nTx * nTy        nThreads = nTx * nTy
78    
79  C--   Initialise the barrier mechanism  C--   Initialise the barrier mechanisms
80    C     BAR2 will eventually replace barrier everywhere.
81        CALL BARRIER_INIT        CALL BARRIER_INIT
82          DO I=1, MAX_NO_THREADS
83           CALL BAR2_INIT(I)
84          ENDDO
85    
86    C--   Initialise exchange mechanism
87          CALL EXCH_INIT
88    
89        IF   ( nThreads .NE. nTx*nTy ) THEN        IF   ( nThreads .NE. nTx*nTy ) THEN
90         WRITE(msgBuf,'(A,A,A,I,A,I)')         WRITE(msgBuf,'(A,A,A,I,A,I)')
# Line 112  C--   Initialise the barrier mechanism Line 97  C--   Initialise the barrier mechanism
97        ENDIF        ENDIF
98        bxPerThread = nSx/nTx        bxPerThread = nSx/nTx
99        IF ( bxPerThread*nTx .NE. nSx ) THEN        IF ( bxPerThread*nTx .NE. nSx ) THEN
100         WRITE(msgBuf,'(A,A)')         WRITE(msgBuf,'(A,A,A)')
101       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
102       &  ' Number of blocks in X (nSx) must be exact multiple of threads in X (nTx).'       &  ' Number of blocks in X (nSx)',
103         &  ' must be exact multiple of threads in X (nTx).'
104         CALL PRINT_ERROR(msgBuf, myThid)         CALL PRINT_ERROR(msgBuf, myThid)
105         eeBootError = .TRUE.         eeBootError = .TRUE.
106         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
107        ENDIF        ENDIF
108        byPerThread = nSy/nTy        byPerThread = nSy/nTy
109        IF ( byPerThread*nTy .NE. nSy ) THEN        IF ( byPerThread*nTy .NE. nSy ) THEN
110         WRITE(msgBuf,'(A,A)')         WRITE(msgBuf,'(A,A,A)')
111       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
112       &  ' Number of blocks in Y (nSy) must be exact multiple of threads in Y (nTy).'       &  ' Number of blocks in Y (nSy)',
113         &  ' must be exact multiple of threads in Y (nTy).'
114         CALL PRINT_ERROR(msgBuf, myThid)         CALL PRINT_ERROR(msgBuf, myThid)
115         eeBootError = .TRUE.         eeBootError = .TRUE.
116         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
# Line 146  C--   Initialise the barrier mechanism Line 133  C--   Initialise the barrier mechanism
133         ENDDO         ENDDO
134        ENDIF        ENDIF
135    
136  C--   Set flags saying how each thread is communicating        DO nT=1,nThreads
137  C     Notes:         CALL INI_COMMUNICATION_PATTERNS( nT )
 C     ======  
 C     By default each block communicates with its neighbor using  
 C     direct reads and writes from the neighbors overlap regions.  
 C     This rule will always applie for the blocks in the interior  
 C     of a processes domain, but for the "outside" faces of blocks on  
 C     the edges of the processes domain i.e. where bx=1 or nSx or  
 C     where by = 1 or nSy. In this section each thread checks to see  
 C     whether any of the blocks it is responsible for are "outside"  
 C     blocks and if so what communication strategy should be used.  
 C     to  
       DO I=1, nThreads  
   
 C      1. Check for block which is on the west edge.  
        commW(I) = COMM_SHARED  
        IF ( notUsingXPeriodicity .AND.  
      &      myBxLo(I) .EQ. 1     .AND.  
      &           myPx .EQ. 1 ) THEN  
         commW(I) = COMM_NONE  
        ELSEIF ( myBxLo(I) .EQ. 1 ) THEN  
 #ifdef  ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
         IF ( usingMPI ) THEN  
 #endif  
          IF ( mpiPidW .NE. MPI_PROC_NULL ) THEN  
           commW(I) = COMM_MPI  
           allMyEdgesAreSharedMemory(I) = .FALSE.  
          ENDIF  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
        ENDIF  
   
 C      2. Check for block which is on the east edge.  
        commE(I) = COMM_SHARED  
        IF ( notUsingXPeriodicity .AND.  
      &      myBxHi(I) .EQ. nSx   .AND.  
      &      myPx .EQ. nPx ) THEN  
         commE(I) = COMM_NONE    
        ELSEIF ( myBxHi(I) .EQ. nSx ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
         IF ( usingMPI ) THEN  
 #endif  
          IF ( mpiPidE .NE. MPI_PROC_NULL ) THEN  
           commE(I) = COMM_MPI  
           allMyEdgesAreSharedMemory(I) = .FALSE.  
          ENDIF  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
        ENDIF  
   
 C      3. Check for block which is southern edge  
        commS(I) = COMM_SHARED  
        IF ( notUsingYPeriodicity .AND.  
      &      myByLo(I) .EQ.   1   .AND.  
      &           myPy .EQ.   1 ) THEN  
         commS(I) = COMM_NONE  
        ELSEIF ( myByLo(I) .EQ. 1 ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
         IF ( usingMPI ) THEN  
 #endif  
          IF ( mpiPidS .NE. MPI_PROC_NULL ) THEN  
           commS(I) = COMM_MPI  
           allMyEdgesAreSharedMemory(I) = .FALSE.  
          ENDIF  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
        ENDIF  
   
 C      4. Check for block which is on northern edge  
        commN(I) = COMM_SHARED  
        IF ( notUsingYPeriodicity .AND.  
      &        myByHi(I) .EQ. nSy .AND.  
      &             myPy .EQ. nPy ) THEN  
         commN(I) = COMM_NONE  
        ELSEIF ( myByHi(I) .EQ. nSy ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
         IF ( usingMPI ) THEN  
 #endif  
          IF ( mpiPidN .NE. MPI_PROC_NULL ) THEN  
           commN(I) = COMM_MPI  
           allMyEdgesAreSharedMemory(I) = .FALSE.  
          ENDIF  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
        ENDIF  
138        ENDDO        ENDDO
139    
140  C--   Print mapping of threads to grid points.  C--   Print mapping of threads to grid points.
141        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
142         &'// ======================================================'
143        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
144       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
145        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
146        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
147       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
148    C     o Write list of tiles each thread is responsible for
149        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
150         &'// ======================================================'
151        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
152       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
153        DO I=1,nThreads        DO I=1,nThreads
154         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
155       & '// -o- Thread',I,', tiles (',       & '// -o- Thread',I,', tiles (',
156       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
157         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_BOTH , 1)         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_BOTH , 1)
        IF ( myBxLo(I) .NE. 1 .OR.  
      &      commW(I) .EQ. COMM_SHARED ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' shared memory to west.'  
        ELSEIF ( commW(I) .NE. COMM_NONE ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' messages to west.'  
        ELSE  
         WRITE(msgBuf,'(A,A)')  '//',' no communication to west.'  
        ENDIF  
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)  
        IF ( myBxHi(I) .NE. nSx .OR.  
      &      commE(I) .EQ. COMM_SHARED ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' shared memory to east.'  
        ELSEIF ( commE(I) .NE. COMM_NONE ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' messages to east.'  
        ELSE  
         WRITE(msgBuf,'(A,A)')  '//',' no communication to east.'  
        ENDIF  
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)  
        IF ( myByLo(I) .NE. 1 .OR.  
      &      commS(I) .EQ. COMM_SHARED ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' shared memory to south.'  
        ELSEIF ( commS(I) .NE. COMM_NONE ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' messages to south.'  
        ELSE  
         WRITE(msgBuf,'(A,A)')  '//',' no communication to south.'  
        ENDIF  
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)  
        IF ( myByHi(I) .NE. nSy .OR.  
      &      commN(I) .EQ. COMM_SHARED ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' shared memory to north.'  
        ELSEIF ( commN(I) .NE. COMM_NONE ) THEN  
         WRITE(msgBuf,'(A,A)')  '//',' messages to north.'  
        ELSE  
         WRITE(msgBuf,'(A,A)')  '//',' no communication to north.'  
        ENDIF  
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)  
158        ENDDO        ENDDO
159        WRITE(msgBuf,'(A)')  ' '        WRITE(msgBuf,'(A)')  ' '
160        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT , 1)
   
 #ifdef ALLOW_USE_MPI  
 C--   Create MPI datatypes for communicating thread boundaries if needed  
 C     For every thread we define 8 MPI datatypes for use  
 C     in indicating regions of data to transfer as follows:  
 C     o mpiTypeXFaceThread_xy_r4  
 C       Handles east-west transfer for XY arrays of REAL*4  
 C     o mpiTypeXFaceThread_xy_r8  
 C       Handles east-west transfer for XY arrays of REAL*8  
 C     o mpiTypeYFaceThread_xy_r4  
 C       Handles north-south transfer for XY arrays of REAL*4  
 C     o mpiTypeYFaceThread_xy_r8  
 C       Handles north-south transfer for XY arrays of REAL*8  
 C     o mpiTypeXFaceThread_xyz_r4  
 C       Handles east-west transfer for XYZ arrays of REAL*4  
 C     o mpiTypeXFaceThread_xyz_r8  
 C       Handles east-west transfer for XYZ arrays of REAL*8  
 C     o mpiTypeYFaceThread_xyz_r4  
 C       Handles north-south transfer for XYZ arrays of REAL*4  
 C     o mpiTypeYFaceThread_xyz_r8  
 C       Handles north-south transfer for XYZarrays of REAL*8  
 #ifndef ALWAYS_USE_MPI  
       IF ( usingMPI ) THEN  
 #endif  
        DO I =1, nThreads  
   
 C       x-face exchanges for xy real*4 data  
         elCount   = myByHi(I)-myByLo(I)+1  
         elLen     = 1  
         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)*nSx  
         arrElSize = 4  
         elStride  = arrElSep*arrElSize  
         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeXFaceBlock_xy_r4,  
      O                        mpiTypeXFaceThread_xy_r4(I), mpiRC )  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeXFaceThread_xy_r4)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
         CALL MPI_TYPE_COMMIT(mpiTypeXFaceThread_xy_r4(I),mpiRC)  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeXFaceThread_xy_r4)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
   
 C       x-face exchanges for xy real*8 data  
         arrElSize = 8  
         elStride  = arrElSep*arrElSize  
         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeXFaceBlock_xy_r8,  
      O                        mpiTypeXFaceThread_xy_r8(I), mpiRC )  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeXFaceThread_xy_r8)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
         CALL MPI_TYPE_COMMIT(mpiTypeXFaceThread_xy_r8(I),mpiRC)  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeXFaceThread_xy_r8)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
   
 C       x-face exchanges for xyz real*4 data  
         elCount   = myByHi(I)-myByLo(I)+1  
         elLen     = 1  
         arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)*Nr*nSx  
         arrElSize = 4  
         elStride  = arrElSep*arrElSize  
         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeXFaceBlock_xyz_r4,  
      O                        mpiTypeXFaceThread_xyz_r4(I), mpiRC )  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeXFaceThread_xyz_r4)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
         CALL MPI_TYPE_COMMIT(mpiTypeXFaceThread_xyz_r4(I),mpiRC)  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeXFaceThread_xyz_r4)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
   
 C       x-face exchanges for xyz real*8 data  
         arrElSize = 8  
         elStride  = arrElSep*arrElSize  
         CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeXFaceBlock_xyz_r8,  
      O                        mpiTypeXFaceThread_xyz_r8(I), mpiRC )  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeXFaceThread_xyz_r8)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
         CALL MPI_TYPE_COMMIT(mpiTypeXFaceThread_xyz_r8(I),mpiRC)  
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN  
          eeBootError = .TRUE.  
          WRITE(msgBuf,'(A,I)')  
      &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeXFaceThread_xyz_r8)',  
      &         mpiRC  
          CALL PRINT_ERROR( msgBuf , myThid)  
         ENDIF  
161    
162  C       y-face exchages for xy real*4 data  C     o For each tile print its communication method(s)
163          elCount   = myBxHi(I)-myBxLo(I)+1        WRITE(msgBuf,'(A)')
164          elLen     = 1       &'// ======================================================'
165          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
166          arrElSize = 4       &  SQUEEZE_RIGHT , 1)
167          elStride  = arrElSep*arrElSize        WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
168          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r4,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
169       O                        mpiTypeYFaceThread_xy_r4(I), mpiRC )       &  SQUEEZE_RIGHT , 1)
170          IF ( mpiRC .NE. MPI_SUCCESS ) THEN        WRITE(msgBuf,'(A)')
171           eeBootError = .TRUE.       &'// ======================================================'
172           WRITE(msgBuf,'(A,I)')        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
173       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r4)',       &  SQUEEZE_RIGHT , 1)
174       &         mpiRC        DO J=1,nSy
175           CALL PRINT_ERROR( msgBuf , myThid)         DO I=1,nSx
176          ENDIF          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')  
177          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r4(I),mpiRC)       &   '//',' Tile number: ',tileNo(I,J),
178          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ' (process no. = ',myPid,')'
179           eeBootError = .TRUE.          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
180           WRITE(msgBuf,'(A,I)')  C       o West communication details
181       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r4)',          IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
182       &         mpiRC           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
183           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        WEST: ',
184          ENDIF       &   'Tile = ',tileNoW(I,J),
185               &   ', Process = ',tilePidW(I,J),
186  C       y-face exchages for xy real*8 data       &   ', Comm = ',commName(tileCommModeW(I,J))
187          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
188          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
189          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r8,       &   '//              ',
190       O                        mpiTypeYFaceThread_xy_r8(I), mpiRC )       &   '  bi = ',tileBiW(I,J),
191          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ', bj = ',tileBjW(I,J)
192           eeBootError = .TRUE.           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
193           WRITE(msgBuf,'(A,I)')          ELSE
194       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r8)',           WRITE(msgBuf,'(A)')
195       &         mpiRC       &   '//         WEST: no neighbor'
196           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
197          ENDIF          ENDIF
198          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r8(I),mpiRC)  C       o East communication details
199          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
200           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
201           WRITE(msgBuf,'(A,I)')       &   '//        EAST: ',
202       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r8)',       &   'Tile = ',tileNoE(I,J),
203       &         mpiRC       &   ', Process = ',tilePidE(I,J),
204           CALL PRINT_ERROR( msgBuf , myThid)       &   ', Comm = ',commName(tileCommModeE(I,J))
205          ENDIF           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
206             WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
207  C       y-face exchages for xyz real*4 data       &   '//              ',
208          elCount   = myBxHi(I)-myBxLo(I)+1       &   '  bi = ',tileBiE(I,J),
209          elLen     = 1       &   ', bj = ',tileBjE(I,J)
210          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)*Nr           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
211          arrElSize = 4          ELSE
212          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A)')
213          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r4,       &   '//         EAST: no neighbor'
214       O                        mpiTypeYFaceThread_xyz_r4(I), mpiRC )           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
215          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          ENDIF
216           eeBootError = .TRUE.  C       o South communication method
217           WRITE(msgBuf,'(A,I)')          IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
218       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r4)',           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
219       &         mpiRC       &   '//       SOUTH: ',
220           CALL PRINT_ERROR( msgBuf , myThid)       &   'Tile = ',tileNoS(I,J),
221          ENDIF       &   ', Process = ',tilePidS(I,J),
222          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r4(I),mpiRC)       &   ', Comm = ',commName(tileCommModeS(I,J))
223          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
224           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
225           WRITE(msgBuf,'(A,I)')       &   '//              ',
226       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r4)',       &   '  bi = ',tileBiS(I,J),
227       &         mpiRC       &   ', bj = ',tileBjS(I,J)
228           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
229          ENDIF          ELSE
230                   WRITE(msgBuf,'(A)')
231  C       y-face exchages for xy real*8 data       &   '//        SOUTH: no neighbor'
232          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
233          elStride  = arrElSep*arrElSize          ENDIF
234          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r8,  C       o North communication method
235       O                        mpiTypeYFaceThread_xyz_r8(I), mpiRC )          IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
236          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
237           eeBootError = .TRUE.       &   '//       NORTH: ',
238           WRITE(msgBuf,'(A,I)')       &   'Tile = ',tileNoN(I,J),
239       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r8)',       &   ', Process = ',tilePidN(I,J),
240       &         mpiRC       &   ', Comm = ',commName(tileCommModeN(I,J))
241           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
242          ENDIF           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
243          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r8(I),mpiRC)       &   '//              ',
244          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   '  bi = ',tileBiN(I,J),
245           eeBootError = .TRUE.       &   ', bj = ',tileBjN(I,J)
246           WRITE(msgBuf,'(A,I)')           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
247       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r8)',          ELSE
248       &         mpiRC           WRITE(msgBuf,'(A)')
249           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        NORTH: no neighbor'
250             CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
251          ENDIF          ENDIF
   
252         ENDDO         ENDDO
   
 #ifndef ALWAYS_USE_MPI  
       ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
   
 C--   Calculate the thread numbers of the threads I might want to "message"  
 C     Notes:  
 C     1. This code needs to be consistent with the code that maps threads to  
 C        blocks earlier in this routine in which threads are arranged  
 C       13 14 15 16 /|\  
 C        9 10 11 12  | nTy  
 C        5  6  7  8  |  
 C        1  2  3  4 \|/  
 C       <---- nTx --->  
 C        on equally sized collections of sNx x sNy sub-blocks.  
       DO I = 1, nThreads  
 C      Find thread to west, east, south, north using wrap around for  
 C      threads managing "outside" blocks.  
        threadWest  = I-1  
        IF ( myBxLo(I) .EQ. 1   ) threadWest  = I+nTx-1  
        threadEast  = I+1  
        IF ( myBxHi(I) .EQ. nSx ) threadEast  = I-nTx+1  
        threadSouth = I-nTx  
        IF ( myByLo(I) .EQ. 1   ) threadSouth = I+nTx*(nTy-1)  
        threadNorth = I+nTx  
        IF ( myByHi(I) .EQ. nSy ) threadNorth = I-nTx*(nTy-1)  
 C      Find thread to NW, NE, SW, SE - again with wrap around.  
        threadNW    = threadWest+nTx  
        IF ( myByHi(threadWest) .EQ. nSy ) threadNW = threadWest-nTx*(nTy-1)  
        threadNE    = threadEast+nTx  
        IF ( myByHi(threadEast) .EQ. nSy ) threadNE = threadEast-nTx*(nTy-1)  
        threadSW    = threadWest-nTx  
        IF ( myByHi(threadWest) .EQ. 1   ) threadSW = threadWest+nTx*(nTy-1)  
        threadSE    = threadEast-nTx  
        IF ( myByHi(threadEast) .EQ. 1   ) threadSE = threadEast+nTx*(nTy-1)  
        myThrW(I)   = threadWest  
        myThrE(I)   = threadEast  
        myThrN(I)   = threadNorth  
        myThrS(I)   = threadSouth  
        myThrNW(I)  = threadNW  
        myThrNE(I)  = threadNE  
        myThrSW(I)  = threadSW  
        myThrSE(I)  = threadSE  
253        ENDDO        ENDDO
254          WRITE(msgBuf,'(A)')  ' '
255          CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
256    
257        RETURN        RETURN
258        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22