/[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.6 by adcroft, Tue May 18 17:39:21 1999 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     \==========================================================/
19          IMPLICIT NONE
20    
21  C     == Global data ==  C     == Global data ==
22  #include "SIZE.h"  #include "SIZE.h"
# Line 35  C                   j index, byHi is the Line 38  C                   j index, byHi is the
38  C     I, J        - Loop counter  C     I, J        - Loop counter
39  C     msgBuf      - I/O buffer for reporting status information.  C     msgBuf      - I/O buffer for reporting status information.
40  C     myThid      - Dummy thread id for use in printed messages  C     myThid      - Dummy thread id for use in printed messages
41  C                   ( this routine "INI_THREADING_ENVIRONMENT" is called before  C                   ( this routine "INI_THREADING_ENVIRONMENT" is
42  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  
43        INTEGER bxPerThread        INTEGER bxPerThread
44        INTEGER byPerThread        INTEGER byPerThread
45        INTEGER Thid        INTEGER Thid
46        INTEGER bxLo, bxHi        INTEGER bxLo, bxHi
47        INTEGER byLo, byHi        INTEGER byLo, byHi
48        INTEGER I, J        INTEGER I, J, nT
49        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
50        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 */  
51    
52  C--   Set default for all threads of having no blocks to  C--   Set default for all threads of having no blocks to
53  C--   work on - except for thread 1.  C--   work on - except for thread 1.
# Line 82  C--   work on - except for thread 1. Line 57  C--   work on - except for thread 1.
57        myByHi(1) = nSy        myByHi(1) = nSy
58        DO I = 2, MAX_NO_THREADS        DO I = 2, MAX_NO_THREADS
59         myBxLo(I) = 0         myBxLo(I) = 0
60         myBxHi(I) = 1         myBxHi(I) = 0
61         myByLo(I) = 0         myByLo(I) = 0
62         myByHi(I) = 1         myByHi(I) = 0
63        ENDDO        ENDDO
64        myThid = 1        myThid = 1
65          commName(COMM_NONE) = 'none'
66          commName(COMM_MSG ) = 'messages'
67          commName(COMM_PUT ) = 'put'
68          commName(COMM_GET ) = 'get'
69    
70  C--   If there are multiple threads allocate different range of the  C--   If there are multiple threads allocate different range of the
71  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 74  C     no. blocks nSy = m*nTy ( where m a
74  C     is handled by simply mapping threads to blocks in sequence  C     is handled by simply mapping threads to blocks in sequence
75  C     with the x thread index moving fastest.  C     with the x thread index moving fastest.
76  C     Later code which sets the thread number of neighboring blocks  C     Later code which sets the thread number of neighboring blocks
77  C     needs to be consisten with the code here.  C     needs to be consistent with the code here.
78        nThreads = nTx * nTy        nThreads = nTx * nTy
79    
80  C--   Initialise the barrier mechanism  C--   Initialise the barrier mechanisms
81    C     BAR2 will eventually replace barrier everywhere.
82        CALL BARRIER_INIT        CALL BARRIER_INIT
83          DO I=1, MAX_NO_THREADS
84           CALL BAR2_INIT(I)
85          ENDDO
86    
87    C--   Initialise exchange mechanism
88          CALL EXCH_INIT
89    
90        IF   ( nThreads .NE. nTx*nTy ) THEN        IF   ( nThreads .NE. nTx*nTy ) THEN
91         WRITE(msgBuf,'(A,A,A,I,A,I)')         WRITE(msgBuf,'(A,A,A,I5,A,I5)')
92       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
93       &  ' Total number of threads is not the same as nTx*nTy.',       &  ' Total number of threads is not the same as nTx*nTy.',
94       &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads       &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
# Line 112  C--   Initialise the barrier mechanism Line 98  C--   Initialise the barrier mechanism
98        ENDIF        ENDIF
99        bxPerThread = nSx/nTx        bxPerThread = nSx/nTx
100        IF ( bxPerThread*nTx .NE. nSx ) THEN        IF ( bxPerThread*nTx .NE. nSx ) THEN
101         WRITE(msgBuf,'(A,A)')         WRITE(msgBuf,'(A,A,A)')
102       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
103       &  ' Number of blocks in X (nSx) must be exact multiple of threads in X (nTx).'       &  ' Number of blocks in X (nSx)',
104         &  ' must be exact multiple of threads in X (nTx).'
105         CALL PRINT_ERROR(msgBuf, myThid)         CALL PRINT_ERROR(msgBuf, myThid)
106         eeBootError = .TRUE.         eeBootError = .TRUE.
107         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
108        ENDIF        ENDIF
109        byPerThread = nSy/nTy        byPerThread = nSy/nTy
110        IF ( byPerThread*nTy .NE. nSy ) THEN        IF ( byPerThread*nTy .NE. nSy ) THEN
111         WRITE(msgBuf,'(A,A)')         WRITE(msgBuf,'(A,A,A)')
112       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
113       &  ' Number of blocks in Y (nSy) must be exact multiple of threads in Y (nTy).'       &  ' Number of blocks in Y (nSy)',
114         &  ' must be exact multiple of threads in Y (nTy).'
115         CALL PRINT_ERROR(msgBuf, myThid)         CALL PRINT_ERROR(msgBuf, myThid)
116         eeBootError = .TRUE.         eeBootError = .TRUE.
117         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
# Line 146  C--   Initialise the barrier mechanism Line 134  C--   Initialise the barrier mechanism
134         ENDDO         ENDDO
135        ENDIF        ENDIF
136    
137  C--   Set flags saying how each thread is communicating        DO nT=1,nThreads
138  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  
139        ENDDO        ENDDO
140    
141  C--   Print mapping of threads to grid points.  C--   Print mapping of threads to grid points.
142        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
143         &'// ======================================================'
144        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
145       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
146        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
147        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
148       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
149    C     o Write list of tiles each thread is responsible for
150        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
151         &'// ======================================================'
152        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
153       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
154        DO I=1,nThreads        DO I=1,nThreads
155         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
156       & '// -o- Thread',I,', tiles (',       & '// -o- Thread',I,', tiles (',
157       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
158         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)  
159        ENDDO        ENDDO
160        WRITE(msgBuf,'(A)')  ' '        WRITE(msgBuf,'(A)')  ' '
161        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  
162    
163  C       y-face exchages for xy real*4 data  C     o For each tile print its communication method(s)
164          elCount   = myBxHi(I)-myBxLo(I)+1        WRITE(msgBuf,'(A)')
165          elLen     = 1       &'// ======================================================'
166          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
167          arrElSize = 4       &  SQUEEZE_RIGHT , 1)
168          elStride  = arrElSep*arrElSize        WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
169          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r4,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
170       O                        mpiTypeYFaceThread_xy_r4(I), mpiRC )       &  SQUEEZE_RIGHT , 1)
171          IF ( mpiRC .NE. MPI_SUCCESS ) THEN        WRITE(msgBuf,'(A)')
172           eeBootError = .TRUE.       &'// ======================================================'
173           WRITE(msgBuf,'(A,I)')        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
174       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r4)',       &  SQUEEZE_RIGHT , 1)
175       &         mpiRC        DO J=1,nSy
176           CALL PRINT_ERROR( msgBuf , myThid)         DO I=1,nSx
177          ENDIF          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')  
178          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r4(I),mpiRC)       &   '//',' Tile number: ',tileNo(I,J),
179          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ' (process no. = ',myPid,')'
180           eeBootError = .TRUE.          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
181           WRITE(msgBuf,'(A,I)')  C       o West communication details
182       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r4)',          IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
183       &         mpiRC           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
184           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        WEST: ',
185          ENDIF       &   'Tile = ',tileNoW(I,J),
186               &   ', Process = ',tilePidW(I,J),
187  C       y-face exchages for xy real*8 data       &   ', Comm = ',commName(tileCommModeW(I,J))
188          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
189          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
190          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r8,       &   '//              ',
191       O                        mpiTypeYFaceThread_xy_r8(I), mpiRC )       &   '  bi = ',tileBiW(I,J),
192          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ', bj = ',tileBjW(I,J)
193           eeBootError = .TRUE.           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
194           WRITE(msgBuf,'(A,I)')          ELSE
195       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r8)',           WRITE(msgBuf,'(A)')
196       &         mpiRC       &   '//         WEST: no neighbor'
197           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
198          ENDIF          ENDIF
199          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r8(I),mpiRC)  C       o East communication details
200          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
201           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
202           WRITE(msgBuf,'(A,I)')       &   '//        EAST: ',
203       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r8)',       &   'Tile = ',tileNoE(I,J),
204       &         mpiRC       &   ', Process = ',tilePidE(I,J),
205           CALL PRINT_ERROR( msgBuf , myThid)       &   ', Comm = ',commName(tileCommModeE(I,J))
206          ENDIF           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
207             WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
208  C       y-face exchages for xyz real*4 data       &   '//              ',
209          elCount   = myBxHi(I)-myBxLo(I)+1       &   '  bi = ',tileBiE(I,J),
210          elLen     = 1       &   ', bj = ',tileBjE(I,J)
211          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)*Nr           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
212          arrElSize = 4          ELSE
213          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A)')
214          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r4,       &   '//         EAST: no neighbor'
215       O                        mpiTypeYFaceThread_xyz_r4(I), mpiRC )           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
216          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          ENDIF
217           eeBootError = .TRUE.  C       o South communication method
218           WRITE(msgBuf,'(A,I)')          IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
219       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r4)',           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
220       &         mpiRC       &   '//       SOUTH: ',
221           CALL PRINT_ERROR( msgBuf , myThid)       &   'Tile = ',tileNoS(I,J),
222          ENDIF       &   ', Process = ',tilePidS(I,J),
223          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r4(I),mpiRC)       &   ', Comm = ',commName(tileCommModeS(I,J))
224          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
225           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
226           WRITE(msgBuf,'(A,I)')       &   '//              ',
227       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r4)',       &   '  bi = ',tileBiS(I,J),
228       &         mpiRC       &   ', bj = ',tileBjS(I,J)
229           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
230          ENDIF          ELSE
231                   WRITE(msgBuf,'(A)')
232  C       y-face exchages for xy real*8 data       &   '//        SOUTH: no neighbor'
233          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
234          elStride  = arrElSep*arrElSize          ENDIF
235          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r8,  C       o North communication method
236       O                        mpiTypeYFaceThread_xyz_r8(I), mpiRC )          IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
237          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
238           eeBootError = .TRUE.       &   '//       NORTH: ',
239           WRITE(msgBuf,'(A,I)')       &   'Tile = ',tileNoN(I,J),
240       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r8)',       &   ', Process = ',tilePidN(I,J),
241       &         mpiRC       &   ', Comm = ',commName(tileCommModeN(I,J))
242           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
243          ENDIF           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
244          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r8(I),mpiRC)       &   '//              ',
245          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   '  bi = ',tileBiN(I,J),
246           eeBootError = .TRUE.       &   ', bj = ',tileBjN(I,J)
247           WRITE(msgBuf,'(A,I)')           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
248       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r8)',          ELSE
249       &         mpiRC           WRITE(msgBuf,'(A)')
250           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        NORTH: no neighbor'
251             CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
252          ENDIF          ENDIF
   
253         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  
254        ENDDO        ENDDO
255          WRITE(msgBuf,'(A)')  ' '
256          CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
257    
258        RETURN        RETURN
259        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22