File indexing completed on 2018-03-02 18:36:11 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
924557e60a Chri*0001 #include "CPP_EEOPTIONS.h"
a25fe875ad Jean*0002 #include "PACKAGES_CONFIG.h"
924557e60a Chri*0003
4c563c2ee9 Chri*0004
0005
0006
0007
924557e60a Chri*0008 SUBROUTINE INI_THREADING_ENVIRONMENT
0009
4c563c2ee9 Chri*0010
0011
92cde3c026 Jean*0012
0013
4c563c2ee9 Chri*0014
92cde3c026 Jean*0015
0016
0017
0018
0019
0020
0021
4c563c2ee9 Chri*0022
0023
0024
7d415c984e Jean*0025 IMPLICIT NONE
924557e60a Chri*0026
0027 #include "SIZE.h"
0028 #include "EEPARAMS.h"
0029 #include "EESUPPORT.h"
0030
4c563c2ee9 Chri*0031
924557e60a Chri*0032
0033
0034
509402efcd Jean*0035
92cde3c026 Jean*0036
924557e60a Chri*0037
0038
0039
0040
0041
0042
0043
0044
0045
92cde3c026 Jean*0046
a85d6ab24e Chri*0047
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
0060
924557e60a Chri*0061
0062
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
0080
0081
0082
0083
92cde3c026 Jean*0084
0085
a85d6ab24e Chri*0086
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
0103
924557e60a Chri*0104 CALL BARRIER_INIT
a85d6ab24e Chri*0105 DO I=1, MAX_NO_THREADS
0106 CALL BAR2_INIT(I)
0107 ENDDO
0108
0109
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
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
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
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
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
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
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
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
509402efcd Jean*0283 #ifndef ALLOW_EXCH2
7d415c984e Jean*0284 IF ( usingMPI .AND. useCubedSphereExchange ) THEN
0285
0286
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
509402efcd Jean*0294
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
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