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

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

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


Revision 1.14 - (hide annotations) (download)
Mon Sep 3 19:30:33 2012 UTC (11 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63s, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.13: +12 -5 lines
add a stop (safer) for EXCH-1 + useCubedSphereExchange when usingMPI=T.

1 jmc 1.14 C $Header: /u/gcmpack/MITgcm/eesupp/src/ini_threading_environment.F,v 1.13 2010/05/17 20:40:43 jmc Exp $
2 cnh 1.8 C $Name: $
3 cnh 1.1
4     #include "CPP_EEOPTIONS.h"
5 jmc 1.11 #include "PACKAGES_CONFIG.h"
6 cnh 1.1
7 cnh 1.8 CBOP
8     C !ROUTINE: INI_THREADING_ENVIRONMENT
9    
10     C !INTERFACE:
11 cnh 1.1 SUBROUTINE INI_THREADING_ENVIRONMENT
12    
13 cnh 1.8 C !DESCRIPTION:
14     C *==========================================================*
15 jmc 1.12 C | SUBROUTINE INI\_THREADING\_ENVIRONMENT
16     C | o Initialise multi-threaded environment.
17 cnh 1.8 C *==========================================================*
18 jmc 1.12 C | Generally we do not start separate threads here.
19     C | The separate threads a spawned at later on.
20     C | Here we perform initialisation of data-structures
21     C | that indicate which of the nSx x nSy tiles a thread is
22     C | responsible for.
23     C | The multiple threads are spawned in the top level MAIN
24     C | routine.
25 cnh 1.8 C *==========================================================*
26    
27     C !USES:
28 jmc 1.14 IMPLICIT NONE
29 cnh 1.1 C == Global data ==
30     #include "SIZE.h"
31     #include "EEPARAMS.h"
32     #include "EESUPPORT.h"
33    
34 cnh 1.8 C !LOCAL VARIABLES:
35 cnh 1.1 C == Local variables ==
36     C bXPerThread - Blocks of size sNx per thread.
37     C byPerThread - Blocks of size sNy per thread.
38 jmc 1.13 C thId - Thread index. Temporary used in loops
39 jmc 1.12 C which set per. thread values on a
40 cnh 1.1 C cartesian grid.
41     C bxLo, bxHi - Work vars. for thread index
42     C byLo, byHi range. bxLo is the lowest i index
43     C that a thread covers, bxHi is the
44     C highest i index. byLo is the lowest
45     C j index, byHi is the highest j index.
46     C I, J - Loop counter
47     C msgBuf - I/O buffer for reporting status information.
48     C myThid - Dummy thread id for use in printed messages
49 jmc 1.12 C ( this routine "INI_THREADING_ENVIRONMENT" is
50 cnh 1.5 C called before multi-threading has started.)
51 cnh 1.1 INTEGER bxPerThread
52     INTEGER byPerThread
53 jmc 1.13 INTEGER thId
54 cnh 1.1 INTEGER bxLo, bxHi
55     INTEGER byLo, byHi
56 jmc 1.13 INTEGER I, J
57 cnh 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
58     INTEGER myThid
59 jmc 1.13 #ifndef ALLOW_EXCH2
60     LOGICAL flag
61     #endif
62 cnh 1.8 CEOP
63 cnh 1.1
64     C-- Set default for all threads of having no blocks to
65     C-- work on - except for thread 1.
66     myBxLo(1) = 1
67     myBxHi(1) = nSx
68     myByLo(1) = 1
69     myByHi(1) = nSy
70     DO I = 2, MAX_NO_THREADS
71     myBxLo(I) = 0
72 cnh 1.5 myBxHi(I) = 0
73 cnh 1.1 myByLo(I) = 0
74 cnh 1.5 myByHi(I) = 0
75 cnh 1.1 ENDDO
76     myThid = 1
77 cnh 1.5 commName(COMM_NONE) = 'none'
78     commName(COMM_MSG ) = 'messages'
79     commName(COMM_PUT ) = 'put'
80     commName(COMM_GET ) = 'get'
81 cnh 1.1
82     C-- If there are multiple threads allocate different range of the
83     C-- nSx*nSy blocks to each thread.
84     C For now handle simple case of no. blocks nSx = n*nTx and
85     C no. blocks nSy = m*nTy ( where m and n are integer ). This
86     C is handled by simply mapping threads to blocks in sequence
87 jmc 1.12 C with the x thread index moving fastest.
88     C Later code which sets the thread number of neighboring blocks
89 cnh 1.5 C needs to be consistent with the code here.
90 cnh 1.1 nThreads = nTx * nTy
91 jmc 1.12 IF ( nThreads .GT. MAX_NO_THREADS ) THEN
92     WRITE(msgBuf,'(2A,2I6)')
93     & 'S/R INI_THREADING_ENVIRONMENT:',
94     & ' Total number of threads exceeds MAX_NO_THREADS',
95     & nTx*nTy, MAX_NO_THREADS
96     CALL PRINT_ERROR(msgBuf, myThid)
97     WRITE(msgBuf,'(2A)')
98     & ' Needs to increase MAX_NO_THREADS',
99     & ' in file "EEPARAMS.h" and to re-compile'
100     CALL PRINT_ERROR(msgBuf, myThid)
101     eeBootError = .TRUE.
102     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
103     ENDIF
104 cnh 1.1
105 cnh 1.5 C-- Initialise the barrier mechanisms
106     C BAR2 will eventually replace barrier everywhere.
107 cnh 1.1 CALL BARRIER_INIT
108 cnh 1.5 DO I=1, MAX_NO_THREADS
109     CALL BAR2_INIT(I)
110     ENDDO
111    
112     C-- Initialise exchange mechanism
113     CALL EXCH_INIT
114 cnh 1.1
115     IF ( nThreads .NE. nTx*nTy ) THEN
116 jmc 1.12 WRITE(msgBuf,'(A,A,A,I5,A,I5)')
117 cnh 1.1 & 'S/R INI_THREADING_ENVIRONMENT:',
118     & ' Total number of threads is not the same as nTx*nTy.',
119     & ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
120     CALL PRINT_ERROR(msgBuf, myThid)
121     eeBootError = .TRUE.
122     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
123     ENDIF
124     bxPerThread = nSx/nTx
125     IF ( bxPerThread*nTx .NE. nSx ) THEN
126 jmc 1.12 WRITE(msgBuf,'(A,A,A)')
127 cnh 1.1 & 'S/R INI_THREADING_ENVIRONMENT:',
128 cnh 1.5 & ' Number of blocks in X (nSx)',
129     & ' must be exact multiple of threads in X (nTx).'
130 cnh 1.1 CALL PRINT_ERROR(msgBuf, myThid)
131     eeBootError = .TRUE.
132     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
133     ENDIF
134     byPerThread = nSy/nTy
135     IF ( byPerThread*nTy .NE. nSy ) THEN
136 jmc 1.12 WRITE(msgBuf,'(A,A,A)')
137 cnh 1.1 & 'S/R INI_THREADING_ENVIRONMENT:',
138 cnh 1.5 & ' Number of blocks in Y (nSy)',
139     & ' must be exact multiple of threads in Y (nTy).'
140 cnh 1.1 CALL PRINT_ERROR(msgBuf, myThid)
141     eeBootError = .TRUE.
142     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
143     ENDIF
144     IF ( .NOT. eeBootError ) THEN
145     byLo = 1
146     DO J=1,nTy
147     byHi = byLo+byPerThread-1
148     bxLo = 1
149     DO I=1,nTx
150 jmc 1.13 thId = (J-1)*nTx+I
151 cnh 1.1 bxHi = bxLo+bxPerThread-1
152 jmc 1.13 myBxLo(thId) = bxLo
153     myBxHi(thId) = bxHi
154     myByLo(thId) = byLo
155     myByHi(thId) = byHi
156 cnh 1.1 bxLo = bxHi+1
157     ENDDO
158     byLo = byHi+1
159     ENDDO
160     ENDIF
161    
162 jmc 1.13 DO thId=1,nThreads
163     CALL INI_COMMUNICATION_PATTERNS( thId )
164 cnh 1.1 ENDDO
165    
166     C-- Print mapping of threads to grid points.
167 jmc 1.12 WRITE(msgBuf,'(A)')
168 cnh 1.5 &'// ======================================================'
169 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
170     & SQUEEZE_RIGHT , 1)
171     WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
172     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
173     & SQUEEZE_RIGHT , 1)
174 cnh 1.5 C o Write list of tiles each thread is responsible for
175 jmc 1.12 WRITE(msgBuf,'(A)')
176 cnh 1.5 &'// ======================================================'
177 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
178     & SQUEEZE_RIGHT , 1)
179     DO I=1,nThreads
180 jmc 1.12 WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
181 cnh 1.1 & '// -o- Thread',I,', tiles (',
182     & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
183 cnh 1.5 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_BOTH , 1)
184 cnh 1.1 ENDDO
185     WRITE(msgBuf,'(A)') ' '
186 cnh 1.5 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT , 1)
187 cnh 1.1
188 jmc 1.11 #ifndef ALLOW_EXCH2
189 cnh 1.5 C o For each tile print its communication method(s)
190 jmc 1.12 WRITE(msgBuf,'(A)')
191 cnh 1.5 &'// ======================================================'
192     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
193     & SQUEEZE_RIGHT , 1)
194     WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
195     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
196     & SQUEEZE_RIGHT , 1)
197 jmc 1.12 WRITE(msgBuf,'(A)')
198 cnh 1.5 &'// ======================================================'
199     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
200     & SQUEEZE_RIGHT , 1)
201     DO J=1,nSy
202     DO I=1,nSx
203 jmc 1.12 WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')
204 cnh 1.5 & '//',' Tile number: ',tileNo(I,J),
205     & ' (process no. = ',myPid,')'
206     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
207     C o West communication details
208     IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
209     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
210     & '// WEST: ',
211     & 'Tile = ',tileNoW(I,J),
212     & ', Process = ',tilePidW(I,J),
213     & ', Comm = ',commName(tileCommModeW(I,J))
214     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
215     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
216     & '// ',
217     & ' bi = ',tileBiW(I,J),
218     & ', bj = ',tileBjW(I,J)
219     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
220     ELSE
221     WRITE(msgBuf,'(A)')
222     & '// WEST: no neighbor'
223     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
224     ENDIF
225     C o East communication details
226     IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
227     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
228     & '// EAST: ',
229     & 'Tile = ',tileNoE(I,J),
230     & ', Process = ',tilePidE(I,J),
231     & ', Comm = ',commName(tileCommModeE(I,J))
232     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
233     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
234     & '// ',
235     & ' bi = ',tileBiE(I,J),
236     & ', bj = ',tileBjE(I,J)
237     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
238     ELSE
239     WRITE(msgBuf,'(A)')
240     & '// EAST: no neighbor'
241     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
242     ENDIF
243     C o South communication method
244     IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
245     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
246     & '// SOUTH: ',
247     & 'Tile = ',tileNoS(I,J),
248     & ', Process = ',tilePidS(I,J),
249     & ', Comm = ',commName(tileCommModeS(I,J))
250     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
251     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
252     & '// ',
253     & ' bi = ',tileBiS(I,J),
254     & ', bj = ',tileBjS(I,J)
255     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
256     ELSE
257     WRITE(msgBuf,'(A)')
258     & '// SOUTH: no neighbor'
259     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
260     ENDIF
261     C o North communication method
262     IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
263     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
264     & '// NORTH: ',
265     & 'Tile = ',tileNoN(I,J),
266     & ', Process = ',tilePidN(I,J),
267     & ', Comm = ',commName(tileCommModeN(I,J))
268     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
269     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
270     & '// ',
271     & ' bi = ',tileBiN(I,J),
272     & ', bj = ',tileBjN(I,J)
273     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
274     ELSE
275     WRITE(msgBuf,'(A)')
276     & '// NORTH: no neighbor'
277     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
278 cnh 1.1 ENDIF
279     ENDDO
280     ENDDO
281 cnh 1.5 WRITE(msgBuf,'(A)') ' '
282     CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
283 jmc 1.11 #endif /* ndef ALLOW_EXCH2 */
284 cnh 1.1
285 jmc 1.14 C-- Check EXCH-1 options
286 jmc 1.13 #ifndef ALLOW_EXCH2
287 jmc 1.14 IF ( usingMPI .AND. useCubedSphereExchange ) THEN
288     C- not working with multi-procs (checked within EXCH1-CUBE S/R) and
289     C- if compiled with MPI (without EXCH2) safer to set usingMPI to False.
290     WRITE(msgBuf,'(2A)') 'EXCH-1 useCubedSphereExchange',
291     & ' unsafe with usingMPI=True'
292     CALL PRINT_ERROR( msgBuf, myThid )
293     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
294     ENDIF
295 jmc 1.13 IF ( nThreads.GT.1 .AND. useCubedSphereExchange ) THEN
296 jmc 1.14 C- multi-threads not working for local arrays; could remove the stop if
297 jmc 1.13 C we are sure that only shared array (=in common blocks) are exchanged.
298     WRITE(msgBuf,'(2A)') 'EXCH-1 useCubedSphereExchange',
299     & ' unsafe with multi-threads'
300     CALL PRINT_ERROR( msgBuf, myThid )
301     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
302     ENDIF
303     IF ( nThreads.GT.1 ) THEN
304     flag = .FALSE.
305     DO J=1,nSy
306     DO I=1,nSx
307     flag = flag
308     & .OR. tileCommModeW(I,J).EQ.COMM_GET
309     & .OR. tileCommModeE(I,J).EQ.COMM_GET
310     & .OR. tileCommModeS(I,J).EQ.COMM_GET
311     & .OR. tileCommModeN(I,J).EQ.COMM_GET
312     ENDDO
313     ENDDO
314     IF ( flag ) THEN
315     C- multi-threads not working for local arrays; not safe neither for shared arrays
316     WRITE(msgBuf,'(3A)') 'EXCH-1 using Comm = ',
317     & commName(COMM_GET), ' unsafe with multi-threads'
318     CALL PRINT_ERROR( msgBuf, myThid )
319     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
320     ENDIF
321     ENDIF
322     #endif /* ndef ALLOW_EXCH2 */
323    
324 cnh 1.1 RETURN
325     END

  ViewVC Help
Powered by ViewVC 1.1.22