/[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.1 by cnh, Wed Apr 22 19:15:30 1998 UTC revision 1.8 by cnh, Fri Sep 21 03:54:35 2001 UTC
# Line 1  Line 1 
1  C $Id$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6  CStartOfInterface  CBOP
7    
8    C     !ROUTINE: INI_THREADING_ENVIRONMENT
9    
10    C     !INTERFACE:
11        SUBROUTINE INI_THREADING_ENVIRONMENT        SUBROUTINE INI_THREADING_ENVIRONMENT
12  C     /==========================================================\        IMPLICIT NONE
13  C     | SUBROUTINE INI_THREADING_ENVIRONMENT                     |  
14  C     | o Initialise multi-threaded environment.                 |  C     !DESCRIPTION:
15  C     |==========================================================|  C     *==========================================================*
16  C     | Generally we do not start separate threads here but      |  C     | SUBROUTINE INI_THREADING_ENVIRONMENT                      
17  C     | just initialise data structures indicating which of the  |  C     | o Initialise multi-threaded environment.                  
18  C     | nSx x nSy blocks a thread is responsible for.            |  C     *==========================================================*
19  C     | The multiple threads are spawned in the top level MAIN   |  C     | Generally we do not start separate threads here.          
20  C     | routine.                                                 |  C     | The separate threads a spawned at later on.              
21  C     \==========================================================/  C     | Here we perform initialisation of data-structures        
22    C     | that indicate which of the nSx x nSy tiles a thread is    
23    C     | responsible for.                                          
24    C     | The multiple threads are spawned in the top level MAIN    
25    C     | routine.                                                  
26    C     *==========================================================*
27    
28    C     !USES:
29  C     == Global data ==  C     == Global data ==
30  #include "SIZE.h"  #include "SIZE.h"
31  #include "EEPARAMS.h"  #include "EEPARAMS.h"
32  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 CEndOfInterface  
33    
34    C     !LOCAL VARIABLES:
35  C     == Local variables ==  C     == Local variables ==
36  C     bXPerThread - Blocks of size sNx per thread.  C     bXPerThread - Blocks of size sNx per thread.
37  C     byPerThread - Blocks of size sNy per thread.  C     byPerThread - Blocks of size sNy per thread.
# Line 35  C                   j index, byHi is the Line 46  C                   j index, byHi is the
46  C     I, J        - Loop counter  C     I, J        - Loop counter
47  C     msgBuf      - I/O buffer for reporting status information.  C     msgBuf      - I/O buffer for reporting status information.
48  C     myThid      - Dummy thread id for use in printed messages  C     myThid      - Dummy thread id for use in printed messages
49  C                   ( this routine "INI_THREADING_ENVIRONMENT" is called before  C                   ( this routine "INI_THREADING_ENVIRONMENT" is
50  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  
51        INTEGER bxPerThread        INTEGER bxPerThread
52        INTEGER byPerThread        INTEGER byPerThread
53        INTEGER Thid        INTEGER Thid
54        INTEGER bxLo, bxHi        INTEGER bxLo, bxHi
55        INTEGER byLo, byHi        INTEGER byLo, byHi
56        INTEGER I, J        INTEGER I, J, nT
57        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
58        INTEGER myThid        INTEGER myThid
59        INTEGER threadWest  
60        INTEGER threadEast  CEOP
       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 */  
61    
62  C--   Set default for all threads of having no blocks to  C--   Set default for all threads of having no blocks to
63  C--   work on - except for thread 1.  C--   work on - except for thread 1.
# Line 82  C--   work on - except for thread 1. Line 67  C--   work on - except for thread 1.
67        myByHi(1) = nSy        myByHi(1) = nSy
68        DO I = 2, MAX_NO_THREADS        DO I = 2, MAX_NO_THREADS
69         myBxLo(I) = 0         myBxLo(I) = 0
70         myBxHi(I) = 1         myBxHi(I) = 0
71         myByLo(I) = 0         myByLo(I) = 0
72         myByHi(I) = 1         myByHi(I) = 0
73        ENDDO        ENDDO
74        myThid = 1        myThid = 1
75          commName(COMM_NONE) = 'none'
76          commName(COMM_MSG ) = 'messages'
77          commName(COMM_PUT ) = 'put'
78          commName(COMM_GET ) = 'get'
79    
80  C--   If there are multiple threads allocate different range of the  C--   If there are multiple threads allocate different range of the
81  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 84  C     no. blocks nSy = m*nTy ( where m a
84  C     is handled by simply mapping threads to blocks in sequence  C     is handled by simply mapping threads to blocks in sequence
85  C     with the x thread index moving fastest.  C     with the x thread index moving fastest.
86  C     Later code which sets the thread number of neighboring blocks  C     Later code which sets the thread number of neighboring blocks
87  C     needs to be consisten with the code here.  C     needs to be consistent with the code here.
88        nThreads = nTx * nTy        nThreads = nTx * nTy
89    
90  C--   Initialise the barrier mechanism  C--   Initialise the barrier mechanisms
91    C     BAR2 will eventually replace barrier everywhere.
92        CALL BARRIER_INIT        CALL BARRIER_INIT
93          DO I=1, MAX_NO_THREADS
94           CALL BAR2_INIT(I)
95          ENDDO
96    
97    C--   Initialise exchange mechanism
98          CALL EXCH_INIT
99    
100        IF   ( nThreads .NE. nTx*nTy ) THEN        IF   ( nThreads .NE. nTx*nTy ) THEN
101         WRITE(msgBuf,'(A,A,A,I,A,I)')         WRITE(msgBuf,'(A,A,A,I5,A,I5)')
102       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
103       &  ' Total number of threads is not the same as nTx*nTy.',       &  ' Total number of threads is not the same as nTx*nTy.',
104       &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads       &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
# Line 112  C--   Initialise the barrier mechanism Line 108  C--   Initialise the barrier mechanism
108        ENDIF        ENDIF
109        bxPerThread = nSx/nTx        bxPerThread = nSx/nTx
110        IF ( bxPerThread*nTx .NE. nSx ) THEN        IF ( bxPerThread*nTx .NE. nSx ) 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 X (nSx) must be exact multiple of threads in X (nTx).'       &  ' Number of blocks in X (nSx)',
114         &  ' must be exact multiple of threads in X (nTx).'
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'
118        ENDIF        ENDIF
119        byPerThread = nSy/nTy        byPerThread = nSy/nTy
120        IF ( byPerThread*nTy .NE. nSy ) THEN        IF ( byPerThread*nTy .NE. nSy ) THEN
121         WRITE(msgBuf,'(A,A)')         WRITE(msgBuf,'(A,A,A)')
122       &  'S/R INI_THREADING_ENVIRONMENT:',       &  'S/R INI_THREADING_ENVIRONMENT:',
123       &  ' Number of blocks in Y (nSy) must be exact multiple of threads in Y (nTy).'       &  ' Number of blocks in Y (nSy)',
124         &  ' must be exact multiple of threads in Y (nTy).'
125         CALL PRINT_ERROR(msgBuf, myThid)         CALL PRINT_ERROR(msgBuf, myThid)
126         eeBootError = .TRUE.         eeBootError = .TRUE.
127         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
# Line 146  C--   Initialise the barrier mechanism Line 144  C--   Initialise the barrier mechanism
144         ENDDO         ENDDO
145        ENDIF        ENDIF
146    
147  C--   Set flags saying how each thread is communicating        DO nT=1,nThreads
148  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  
149        ENDDO        ENDDO
150    
151  C--   Print mapping of threads to grid points.  C--   Print mapping of threads to grid points.
152        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
153         &'// ======================================================'
154        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
155       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
156        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'        WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
157        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
158       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
159    C     o Write list of tiles each thread is responsible for
160        WRITE(msgBuf,'(A)') '// ======================================================'        WRITE(msgBuf,'(A)')
161         &'// ======================================================'
162        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
163       &  SQUEEZE_RIGHT , 1)       &  SQUEEZE_RIGHT , 1)
   
164        DO I=1,nThreads        DO I=1,nThreads
165         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')         WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
166       & '// -o- Thread',I,', tiles (',       & '// -o- Thread',I,', tiles (',
167       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'       & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
168         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)  
169        ENDDO        ENDDO
170        WRITE(msgBuf,'(A)')  ' '        WRITE(msgBuf,'(A)')  ' '
171        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)*Nz*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  
172    
173  C       y-face exchages for xy real*4 data  C     o For each tile print its communication method(s)
174          elCount   = myBxHi(I)-myBxLo(I)+1        WRITE(msgBuf,'(A)')
175          elLen     = 1       &'// ======================================================'
176          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
177          arrElSize = 4       &  SQUEEZE_RIGHT , 1)
178          elStride  = arrElSep*arrElSize        WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
179          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r4,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
180       O                        mpiTypeYFaceThread_xy_r4(I), mpiRC )       &  SQUEEZE_RIGHT , 1)
181          IF ( mpiRC .NE. MPI_SUCCESS ) THEN        WRITE(msgBuf,'(A)')
182           eeBootError = .TRUE.       &'// ======================================================'
183           WRITE(msgBuf,'(A,I)')        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
184       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r4)',       &  SQUEEZE_RIGHT , 1)
185       &         mpiRC        DO J=1,nSy
186           CALL PRINT_ERROR( msgBuf , myThid)         DO I=1,nSx
187          ENDIF          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')  
188          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r4(I),mpiRC)       &   '//',' Tile number: ',tileNo(I,J),
189          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ' (process no. = ',myPid,')'
190           eeBootError = .TRUE.          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
191           WRITE(msgBuf,'(A,I)')  C       o West communication details
192       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r4)',          IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
193       &         mpiRC           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
194           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        WEST: ',
195          ENDIF       &   'Tile = ',tileNoW(I,J),
196               &   ', Process = ',tilePidW(I,J),
197  C       y-face exchages for xy real*8 data       &   ', Comm = ',commName(tileCommModeW(I,J))
198          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
199          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
200          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xy_r8,       &   '//              ',
201       O                        mpiTypeYFaceThread_xy_r8(I), mpiRC )       &   '  bi = ',tileBiW(I,J),
202          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   ', bj = ',tileBjW(I,J)
203           eeBootError = .TRUE.           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
204           WRITE(msgBuf,'(A,I)')          ELSE
205       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xy_r8)',           WRITE(msgBuf,'(A)')
206       &         mpiRC       &   '//         WEST: no neighbor'
207           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
208          ENDIF          ENDIF
209          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xy_r8(I),mpiRC)  C       o East communication details
210          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
211           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
212           WRITE(msgBuf,'(A,I)')       &   '//        EAST: ',
213       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xy_r8)',       &   'Tile = ',tileNoE(I,J),
214       &         mpiRC       &   ', Process = ',tilePidE(I,J),
215           CALL PRINT_ERROR( msgBuf , myThid)       &   ', Comm = ',commName(tileCommModeE(I,J))
216          ENDIF           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
217             WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
218  C       y-face exchages for xyz real*4 data       &   '//              ',
219          elCount   = myBxHi(I)-myBxLo(I)+1       &   '  bi = ',tileBiE(I,J),
220          elLen     = 1       &   ', bj = ',tileBjE(I,J)
221          arrElSep  = (sNx+OLx*2)*(sNy+OLy*2)*Nz           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
222          arrElSize = 4          ELSE
223          elStride  = arrElSep*arrElSize           WRITE(msgBuf,'(A)')
224          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r4,       &   '//         EAST: no neighbor'
225       O                        mpiTypeYFaceThread_xyz_r4(I), mpiRC )           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
226          IF ( mpiRC .NE. MPI_SUCCESS ) THEN          ENDIF
227           eeBootError = .TRUE.  C       o South communication method
228           WRITE(msgBuf,'(A,I)')          IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
229       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r4)',           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
230       &         mpiRC       &   '//       SOUTH: ',
231           CALL PRINT_ERROR( msgBuf , myThid)       &   'Tile = ',tileNoS(I,J),
232          ENDIF       &   ', Process = ',tilePidS(I,J),
233          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r4(I),mpiRC)       &   ', Comm = ',commName(tileCommModeS(I,J))
234          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
235           eeBootError = .TRUE.           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
236           WRITE(msgBuf,'(A,I)')       &   '//              ',
237       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r4)',       &   '  bi = ',tileBiS(I,J),
238       &         mpiRC       &   ', bj = ',tileBjS(I,J)
239           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
240          ENDIF          ELSE
241                   WRITE(msgBuf,'(A)')
242  C       y-face exchages for xy real*8 data       &   '//        SOUTH: no neighbor'
243          arrElSize = 8           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
244          elStride  = arrElSep*arrElSize          ENDIF
245          CALL MPI_TYPE_HVECTOR(elCount,elLen,elStride,mpiTypeYFaceBlock_xyz_r8,  C       o North communication method
246       O                        mpiTypeYFaceThread_xyz_r8(I), mpiRC )          IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
247          IF ( mpiRC .NE. MPI_SUCCESS ) THEN           WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
248           eeBootError = .TRUE.       &   '//       NORTH: ',
249           WRITE(msgBuf,'(A,I)')       &   'Tile = ',tileNoN(I,J),
250       &         'S/R INI_THREADS: MPI_TYPE_HVECTOR (mpiTypeYFaceThread_xyz_r8)',       &   ', Process = ',tilePidN(I,J),
251       &         mpiRC       &   ', Comm = ',commName(tileCommModeN(I,J))
252           CALL PRINT_ERROR( msgBuf , myThid)           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
253          ENDIF           WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
254          CALL MPI_TYPE_COMMIT(mpiTypeYFaceThread_xyz_r8(I),mpiRC)       &   '//              ',
255          IF ( mpiRC .NE. MPI_SUCCESS ) THEN       &   '  bi = ',tileBiN(I,J),
256           eeBootError = .TRUE.       &   ', bj = ',tileBjN(I,J)
257           WRITE(msgBuf,'(A,I)')           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
258       &         'S/R INI_THREADS: MPI_TYPE_COMMIT (mpiTypeYFaceThread_xyz_r8)',          ELSE
259       &         mpiRC           WRITE(msgBuf,'(A)')
260           CALL PRINT_ERROR( msgBuf , myThid)       &   '//        NORTH: no neighbor'
261             CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
262          ENDIF          ENDIF
   
263         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  
264        ENDDO        ENDDO
265          WRITE(msgBuf,'(A)')  ' '
266          CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
267    
268        RETURN        RETURN
269        END        END
   
 C $Id$  
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22