eesupp/src/ini_threading_environment.F

924557e60a Chri*0001 #include "CPP_EEOPTIONS.h"
a25fe875ad Jean*0002 #include "PACKAGES_CONFIG.h"
924557e60a Chri*0003
4c563c2ee9 Chri*0004 CBOP
                0005 C     !ROUTINE: INI_THREADING_ENVIRONMENT
                0006
                0007 C     !INTERFACE:
924557e60a Chri*0008       SUBROUTINE INI_THREADING_ENVIRONMENT
                0009
4c563c2ee9 Chri*0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
92cde3c026 Jean*0012 C     | SUBROUTINE INI\_THREADING\_ENVIRONMENT
                0013 C     | o Initialise multi-threaded environment.
4c563c2ee9 Chri*0014 C     *==========================================================*
92cde3c026 Jean*0015 C     | Generally we do not start separate threads here.
                0016 C     | The separate threads a spawned at later on.
                0017 C     | Here we perform initialisation of data-structures
                0018 C     | that indicate which of the nSx x nSy tiles a thread is
                0019 C     | responsible for.
                0020 C     | The multiple threads are spawned in the top level MAIN
                0021 C     | routine.
4c563c2ee9 Chri*0022 C     *==========================================================*
                0023
                0024 C     !USES:
7d415c984e Jean*0025       IMPLICIT NONE
924557e60a Chri*0026 C     == Global data ==
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "EESUPPORT.h"
                0030
4c563c2ee9 Chri*0031 C     !LOCAL VARIABLES:
924557e60a Chri*0032 C     == Local variables ==
                0033 C     bXPerThread - Blocks of size sNx per thread.
                0034 C     byPerThread - Blocks of size sNy per thread.
509402efcd Jean*0035 C     thId        - Thread index. Temporary used in loops
92cde3c026 Jean*0036 C                   which set per. thread values on a
924557e60a Chri*0037 C                   cartesian grid.
                0038 C     bxLo, bxHi  - Work vars. for thread index
                0039 C     byLo, byHi    range. bxLo is the lowest i index
                0040 C                   that a thread covers, bxHi is the
                0041 C                   highest i index. byLo is the lowest
                0042 C                   j index, byHi is the highest j index.
                0043 C     I, J        - Loop counter
                0044 C     msgBuf      - I/O buffer for reporting status information.
                0045 C     myThid      - Dummy thread id for use in printed messages
92cde3c026 Jean*0046 C                   ( this routine "INI_THREADING_ENVIRONMENT" is
a85d6ab24e Chri*0047 C                     called before multi-threading has started.)
924557e60a Chri*0048       INTEGER bxPerThread
                0049       INTEGER byPerThread
509402efcd Jean*0050       INTEGER thId
924557e60a Chri*0051       INTEGER bxLo, bxHi
                0052       INTEGER byLo, byHi
509402efcd Jean*0053       INTEGER I, J
924557e60a Chri*0054       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0055       INTEGER myThid
509402efcd Jean*0056 #ifndef ALLOW_EXCH2
                0057       LOGICAL flag
                0058 #endif
4c563c2ee9 Chri*0059 CEOP
                0060
924557e60a Chri*0061 C--   Set default for all threads of having no blocks to
                0062 C--   work on - except for thread 1.
                0063       myBxLo(1) = 1
                0064       myBxHi(1) = nSx
                0065       myByLo(1) = 1
                0066       myByHi(1) = nSy
                0067       DO I = 2, MAX_NO_THREADS
                0068        myBxLo(I) = 0
a85d6ab24e Chri*0069        myBxHi(I) = 0
924557e60a Chri*0070        myByLo(I) = 0
a85d6ab24e Chri*0071        myByHi(I) = 0
924557e60a Chri*0072       ENDDO
                0073       myThid = 1
a85d6ab24e Chri*0074       commName(COMM_NONE) = 'none'
                0075       commName(COMM_MSG ) = 'messages'
                0076       commName(COMM_PUT ) = 'put'
                0077       commName(COMM_GET ) = 'get'
924557e60a Chri*0078
                0079 C--   If there are multiple threads allocate different range of the
                0080 C--   nSx*nSy blocks to each thread.
                0081 C     For now handle simple case of no. blocks nSx = n*nTx and
                0082 C     no. blocks nSy = m*nTy ( where m and n are integer ). This
                0083 C     is handled by simply mapping threads to blocks in sequence
92cde3c026 Jean*0084 C     with the x thread index moving fastest.
                0085 C     Later code which sets the thread number of neighboring blocks
a85d6ab24e Chri*0086 C     needs to be consistent with the code here.
924557e60a Chri*0087       nThreads = nTx * nTy
92cde3c026 Jean*0088       IF   ( nThreads .GT. MAX_NO_THREADS ) THEN
                0089        WRITE(msgBuf,'(2A,2I6)')
                0090      &  'S/R INI_THREADING_ENVIRONMENT:',
                0091      &  ' Total number of threads exceeds MAX_NO_THREADS',
                0092      &   nTx*nTy, MAX_NO_THREADS
                0093        CALL PRINT_ERROR(msgBuf, myThid)
                0094        WRITE(msgBuf,'(2A)')
                0095      &    ' Needs to increase MAX_NO_THREADS',
                0096      &    ' in file "EEPARAMS.h" and to re-compile'
                0097        CALL PRINT_ERROR(msgBuf, myThid)
                0098        eeBootError = .TRUE.
                0099        STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0100       ENDIF
924557e60a Chri*0101
a85d6ab24e Chri*0102 C--   Initialise the barrier mechanisms
                0103 C     BAR2 will eventually replace barrier everywhere.
924557e60a Chri*0104       CALL BARRIER_INIT
a85d6ab24e Chri*0105       DO I=1, MAX_NO_THREADS
                0106        CALL BAR2_INIT(I)
                0107       ENDDO
                0108
                0109 C--   Initialise exchange mechanism
                0110       CALL EXCH_INIT
924557e60a Chri*0111
                0112       IF   ( nThreads .NE. nTx*nTy ) THEN
92cde3c026 Jean*0113        WRITE(msgBuf,'(A,A,A,I5,A,I5)')
924557e60a Chri*0114      &  'S/R INI_THREADING_ENVIRONMENT:',
                0115      &  ' Total number of threads is not the same as nTx*nTy.',
                0116      &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
                0117        CALL PRINT_ERROR(msgBuf, myThid)
                0118        eeBootError = .TRUE.
d47efaa849 Jean*0119        STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0120       ENDIF
924557e60a Chri*0121       bxPerThread = nSx/nTx
                0122       IF ( bxPerThread*nTx .NE. nSx ) THEN
92cde3c026 Jean*0123        WRITE(msgBuf,'(A,A,A)')
924557e60a Chri*0124      &  'S/R INI_THREADING_ENVIRONMENT:',
a85d6ab24e Chri*0125      &  ' Number of blocks in X (nSx)',
                0126      &  ' must be exact multiple of threads in X (nTx).'
924557e60a Chri*0127        CALL PRINT_ERROR(msgBuf, myThid)
                0128        eeBootError = .TRUE.
                0129        STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0130       ENDIF
                0131       byPerThread = nSy/nTy
                0132       IF ( byPerThread*nTy .NE. nSy ) THEN
92cde3c026 Jean*0133        WRITE(msgBuf,'(A,A,A)')
924557e60a Chri*0134      &  'S/R INI_THREADING_ENVIRONMENT:',
a85d6ab24e Chri*0135      &  ' Number of blocks in Y (nSy)',
                0136      &  ' must be exact multiple of threads in Y (nTy).'
924557e60a Chri*0137        CALL PRINT_ERROR(msgBuf, myThid)
                0138        eeBootError = .TRUE.
                0139        STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0140       ENDIF
                0141       IF ( .NOT. eeBootError ) THEN
                0142        byLo = 1
                0143        DO J=1,nTy
                0144         byHi = byLo+byPerThread-1
                0145         bxLo = 1
                0146         DO I=1,nTx
509402efcd Jean*0147          thId = (J-1)*nTx+I
924557e60a Chri*0148          bxHi = bxLo+bxPerThread-1
509402efcd Jean*0149          myBxLo(thId) = bxLo
                0150          myBxHi(thId) = bxHi
                0151          myByLo(thId) = byLo
                0152          myByHi(thId) = byHi
924557e60a Chri*0153          bxLo = bxHi+1
                0154         ENDDO
                0155         byLo = byHi+1
                0156        ENDDO
                0157       ENDIF
                0158
509402efcd Jean*0159       DO thId=1,nThreads
                0160        CALL INI_COMMUNICATION_PATTERNS( thId )
924557e60a Chri*0161       ENDDO
                0162
                0163 C--   Print mapping of threads to grid points.
92cde3c026 Jean*0164       WRITE(msgBuf,'(A)')
a85d6ab24e Chri*0165      &'// ======================================================'
924557e60a Chri*0166       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0167      &  SQUEEZE_RIGHT , 1)
                0168       WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
                0169       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0170      &  SQUEEZE_RIGHT , 1)
a85d6ab24e Chri*0171 C     o Write list of tiles each thread is responsible for
92cde3c026 Jean*0172       WRITE(msgBuf,'(A)')
a85d6ab24e Chri*0173      &'// ======================================================'
924557e60a Chri*0174       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0175      &  SQUEEZE_RIGHT , 1)
                0176       DO I=1,nThreads
92cde3c026 Jean*0177        WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
924557e60a Chri*0178      & '// -o- Thread',I,', tiles (',
                0179      & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
a85d6ab24e Chri*0180        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_BOTH , 1)
924557e60a Chri*0181       ENDDO
                0182       WRITE(msgBuf,'(A)')  ' '
a85d6ab24e Chri*0183       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT , 1)
924557e60a Chri*0184
a25fe875ad Jean*0185 #ifndef ALLOW_EXCH2
a85d6ab24e Chri*0186 C     o For each tile print its communication method(s)
92cde3c026 Jean*0187       WRITE(msgBuf,'(A)')
a85d6ab24e Chri*0188      &'// ======================================================'
                0189       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0190      &  SQUEEZE_RIGHT , 1)
                0191       WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
                0192       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0193      &  SQUEEZE_RIGHT , 1)
92cde3c026 Jean*0194       WRITE(msgBuf,'(A)')
a85d6ab24e Chri*0195      &'// ======================================================'
                0196       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0197      &  SQUEEZE_RIGHT , 1)
                0198       DO J=1,nSy
                0199        DO I=1,nSx
92cde3c026 Jean*0200         WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')
a85d6ab24e Chri*0201      &   '//',' Tile number: ',tileNo(I,J),
                0202      &   ' (process no. = ',myPid,')'
                0203         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
                0204 C       o West communication details
                0205         IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
                0206          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
                0207      &   '//        WEST: ',
                0208      &   'Tile = ',tileNoW(I,J),
                0209      &   ', Process = ',tilePidW(I,J),
                0210      &   ', Comm = ',commName(tileCommModeW(I,J))
                0211          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0212          WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
                0213      &   '//              ',
                0214      &   '  bi = ',tileBiW(I,J),
                0215      &   ', bj = ',tileBjW(I,J)
                0216          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0217         ELSE
                0218          WRITE(msgBuf,'(A)')
                0219      &   '//         WEST: no neighbor'
                0220          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
924557e60a Chri*0221         ENDIF
a85d6ab24e Chri*0222 C       o East communication details
                0223         IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
                0224          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
                0225      &   '//        EAST: ',
                0226      &   'Tile = ',tileNoE(I,J),
                0227      &   ', Process = ',tilePidE(I,J),
                0228      &   ', Comm = ',commName(tileCommModeE(I,J))
                0229          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0230          WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
                0231      &   '//              ',
                0232      &   '  bi = ',tileBiE(I,J),
                0233      &   ', bj = ',tileBjE(I,J)
                0234          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0235         ELSE
                0236          WRITE(msgBuf,'(A)')
                0237      &   '//         EAST: no neighbor'
                0238          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
924557e60a Chri*0239         ENDIF
a85d6ab24e Chri*0240 C       o South communication method
                0241         IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
                0242          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
                0243      &   '//       SOUTH: ',
                0244      &   'Tile = ',tileNoS(I,J),
                0245      &   ', Process = ',tilePidS(I,J),
                0246      &   ', Comm = ',commName(tileCommModeS(I,J))
                0247          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0248          WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
                0249      &   '//              ',
                0250      &   '  bi = ',tileBiS(I,J),
                0251      &   ', bj = ',tileBjS(I,J)
                0252          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0253         ELSE
                0254          WRITE(msgBuf,'(A)')
                0255      &   '//        SOUTH: no neighbor'
                0256          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
924557e60a Chri*0257         ENDIF
a85d6ab24e Chri*0258 C       o North communication method
                0259         IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
                0260          WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
                0261      &   '//       NORTH: ',
                0262      &   'Tile = ',tileNoN(I,J),
                0263      &   ', Process = ',tilePidN(I,J),
                0264      &   ', Comm = ',commName(tileCommModeN(I,J))
                0265          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0266          WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
                0267      &   '//              ',
                0268      &   '  bi = ',tileBiN(I,J),
                0269      &   ', bj = ',tileBjN(I,J)
                0270          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
                0271         ELSE
                0272          WRITE(msgBuf,'(A)')
                0273      &   '//        NORTH: no neighbor'
                0274          CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
924557e60a Chri*0275         ENDIF
                0276        ENDDO
                0277       ENDDO
a85d6ab24e Chri*0278       WRITE(msgBuf,'(A)')  ' '
                0279       CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
a25fe875ad Jean*0280 #endif /* ndef ALLOW_EXCH2 */
924557e60a Chri*0281
7d415c984e Jean*0282 C--   Check EXCH-1 options
509402efcd Jean*0283 #ifndef ALLOW_EXCH2
7d415c984e Jean*0284       IF ( usingMPI .AND. useCubedSphereExchange ) THEN
                0285 C-    not working with multi-procs (checked within EXCH1-CUBE S/R) and
                0286 C-    if compiled with MPI (without EXCH2) safer to set usingMPI to False.
                0287         WRITE(msgBuf,'(2A)') 'EXCH-1 useCubedSphereExchange',
                0288      &                       ' unsafe with usingMPI=True'
                0289         CALL PRINT_ERROR( msgBuf, myThid )
                0290         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0291       ENDIF
509402efcd Jean*0292       IF ( nThreads.GT.1 .AND. useCubedSphereExchange ) THEN
7d415c984e Jean*0293 C-    multi-threads not working for local arrays; could remove the stop if
509402efcd Jean*0294 C     we are sure that only shared array (=in common blocks) are exchanged.
                0295         WRITE(msgBuf,'(2A)') 'EXCH-1 useCubedSphereExchange',
                0296      &                       ' unsafe with multi-threads'
                0297         CALL PRINT_ERROR( msgBuf, myThid )
                0298         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0299       ENDIF
                0300       IF ( nThreads.GT.1 ) THEN
                0301        flag = .FALSE.
                0302        DO J=1,nSy
                0303         DO I=1,nSx
                0304           flag = flag
                0305      &       .OR. tileCommModeW(I,J).EQ.COMM_GET
                0306      &       .OR. tileCommModeE(I,J).EQ.COMM_GET
                0307      &       .OR. tileCommModeS(I,J).EQ.COMM_GET
                0308      &       .OR. tileCommModeN(I,J).EQ.COMM_GET
                0309         ENDDO
                0310        ENDDO
                0311        IF ( flag ) THEN
                0312 C-    multi-threads not working for local arrays; not safe neither for shared arrays
                0313         WRITE(msgBuf,'(3A)') 'EXCH-1 using Comm = ',
                0314      &   commName(COMM_GET), ' unsafe with multi-threads'
                0315         CALL PRINT_ERROR( msgBuf, myThid )
                0316         STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
                0317        ENDIF
                0318       ENDIF
                0319 #endif /* ndef ALLOW_EXCH2 */
                0320
924557e60a Chri*0321       RETURN
                0322       END