/[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.5 - (hide annotations) (download)
Tue Sep 29 18:50:56 1998 UTC (25 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint15, checkpoint17, checkpoint19, checkpoint18, checkpoint20, checkpoint21, checkpoint16
Changes since 1.4: +130 -431 lines
Changes for new exchange routines which do general tile <-> tile
connectivity, variable width overlap regions and provide
hooks for shared memory  and DMA protocols like Arctic, Memory Channel
etc..

1 cnh 1.5 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/ini_threading_environment.F,v 1.4 1998/08/22 17:51:06 cnh Exp $
2 cnh 1.1
3     #include "CPP_EEOPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE INI_THREADING_ENVIRONMENT
7     C /==========================================================\
8     C | SUBROUTINE INI_THREADING_ENVIRONMENT |
9     C | o Initialise multi-threaded environment. |
10     C |==========================================================|
11 cnh 1.5 C | Generally we do not start separate threads here. |
12     C | The separate threads a spawned at later on. |
13     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 cnh 1.1 C | The multiple threads are spawned in the top level MAIN |
17     C | routine. |
18     C \==========================================================/
19    
20     C == Global data ==
21     #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "EESUPPORT.h"
24     CEndOfInterface
25    
26     C == Local variables ==
27     C bXPerThread - Blocks of size sNx per thread.
28     C byPerThread - Blocks of size sNy per thread.
29     C Thid - Thread index. Temporary used in loops
30     C which set per. thread values on a
31     C cartesian grid.
32     C bxLo, bxHi - Work vars. for thread index
33     C byLo, byHi range. bxLo is the lowest i index
34     C that a thread covers, bxHi is the
35     C highest i index. byLo is the lowest
36     C j index, byHi is the highest j index.
37     C I, J - Loop counter
38     C msgBuf - I/O buffer for reporting status information.
39     C myThid - Dummy thread id for use in printed messages
40 cnh 1.5 C ( this routine "INI_THREADING_ENVIRONMENT" is
41     C called before multi-threading has started.)
42 cnh 1.1 INTEGER bxPerThread
43     INTEGER byPerThread
44     INTEGER Thid
45     INTEGER bxLo, bxHi
46     INTEGER byLo, byHi
47 cnh 1.5 INTEGER I, J, nT
48 cnh 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
49     INTEGER myThid
50    
51     C-- Set default for all threads of having no blocks to
52     C-- work on - except for thread 1.
53     myBxLo(1) = 1
54     myBxHi(1) = nSx
55     myByLo(1) = 1
56     myByHi(1) = nSy
57     DO I = 2, MAX_NO_THREADS
58     myBxLo(I) = 0
59 cnh 1.5 myBxHi(I) = 0
60 cnh 1.1 myByLo(I) = 0
61 cnh 1.5 myByHi(I) = 0
62 cnh 1.1 ENDDO
63     myThid = 1
64 cnh 1.5 commName(COMM_NONE) = 'none'
65     commName(COMM_MSG ) = 'messages'
66     commName(COMM_PUT ) = 'put'
67     commName(COMM_GET ) = 'get'
68 cnh 1.1
69     C-- If there are multiple threads allocate different range of the
70     C-- nSx*nSy blocks to each thread.
71     C For now handle simple case of no. blocks nSx = n*nTx and
72     C no. blocks nSy = m*nTy ( where m and n are integer ). This
73     C is handled by simply mapping threads to blocks in sequence
74     C with the x thread index moving fastest.
75     C Later code which sets the thread number of neighboring blocks
76 cnh 1.5 C needs to be consistent with the code here.
77 cnh 1.1 nThreads = nTx * nTy
78    
79 cnh 1.5 C-- Initialise the barrier mechanisms
80     C BAR2 will eventually replace barrier everywhere.
81 cnh 1.1 CALL BARRIER_INIT
82 cnh 1.5 DO I=1, MAX_NO_THREADS
83     CALL BAR2_INIT(I)
84     ENDDO
85    
86     C-- Initialise exchange mechanism
87     CALL EXCH_INIT
88 cnh 1.1
89     IF ( nThreads .NE. nTx*nTy ) THEN
90     WRITE(msgBuf,'(A,A,A,I,A,I)')
91     & 'S/R INI_THREADING_ENVIRONMENT:',
92     & ' Total number of threads is not the same as nTx*nTy.',
93     & ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
94     CALL PRINT_ERROR(msgBuf, myThid)
95     eeBootError = .TRUE.
96     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
97     ENDIF
98     bxPerThread = nSx/nTx
99     IF ( bxPerThread*nTx .NE. nSx ) THEN
100 cnh 1.5 WRITE(msgBuf,'(A,A,A)')
101 cnh 1.1 & 'S/R INI_THREADING_ENVIRONMENT:',
102 cnh 1.5 & ' Number of blocks in X (nSx)',
103     & ' must be exact multiple of threads in X (nTx).'
104 cnh 1.1 CALL PRINT_ERROR(msgBuf, myThid)
105     eeBootError = .TRUE.
106     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
107     ENDIF
108     byPerThread = nSy/nTy
109     IF ( byPerThread*nTy .NE. nSy ) THEN
110 cnh 1.5 WRITE(msgBuf,'(A,A,A)')
111 cnh 1.1 & 'S/R INI_THREADING_ENVIRONMENT:',
112 cnh 1.5 & ' Number of blocks in Y (nSy)',
113     & ' must be exact multiple of threads in Y (nTy).'
114 cnh 1.1 CALL PRINT_ERROR(msgBuf, myThid)
115     eeBootError = .TRUE.
116     STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
117     ENDIF
118     IF ( .NOT. eeBootError ) THEN
119     byLo = 1
120     DO J=1,nTy
121     byHi = byLo+byPerThread-1
122     bxLo = 1
123     DO I=1,nTx
124     Thid = (J-1)*nTx+I
125     bxHi = bxLo+bxPerThread-1
126     myBxLo(Thid) = bxLo
127     myBxHi(Thid) = bxHi
128     myByLo(Thid) = byLo
129     myByHi(Thid) = byHi
130     bxLo = bxHi+1
131     ENDDO
132     byLo = byHi+1
133     ENDDO
134     ENDIF
135    
136 cnh 1.5 DO nT=1,nThreads
137     CALL INI_COMMUNICATION_PATTERNS( nT )
138 cnh 1.1 ENDDO
139    
140     C-- Print mapping of threads to grid points.
141 cnh 1.5 WRITE(msgBuf,'(A)')
142     &'// ======================================================'
143 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
144     & SQUEEZE_RIGHT , 1)
145     WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
146     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
147     & SQUEEZE_RIGHT , 1)
148 cnh 1.5 C o Write list of tiles each thread is responsible for
149     WRITE(msgBuf,'(A)')
150     &'// ======================================================'
151 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
152     & SQUEEZE_RIGHT , 1)
153     DO I=1,nThreads
154     WRITE(msgBuf,'(A,I4,A,4(I4,A1))')
155     & '// -o- Thread',I,', tiles (',
156     & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
157 cnh 1.5 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_BOTH , 1)
158 cnh 1.1 ENDDO
159     WRITE(msgBuf,'(A)') ' '
160 cnh 1.5 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT , 1)
161 cnh 1.1
162 cnh 1.5 C o For each tile print its communication method(s)
163     WRITE(msgBuf,'(A)')
164     &'// ======================================================'
165     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
166     & SQUEEZE_RIGHT , 1)
167     WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
168     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
169     & SQUEEZE_RIGHT , 1)
170     WRITE(msgBuf,'(A)')
171     &'// ======================================================'
172     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
173     & SQUEEZE_RIGHT , 1)
174     DO J=1,nSy
175     DO I=1,nSx
176     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')
177     & '//',' Tile number: ',tileNo(I,J),
178     & ' (process no. = ',myPid,')'
179     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
180     C o West communication details
181     IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
182     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
183     & '// WEST: ',
184     & 'Tile = ',tileNoW(I,J),
185     & ', Process = ',tilePidW(I,J),
186     & ', Comm = ',commName(tileCommModeW(I,J))
187     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
188     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
189     & '// ',
190     & ' bi = ',tileBiW(I,J),
191     & ', bj = ',tileBjW(I,J)
192     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
193     ELSE
194     WRITE(msgBuf,'(A)')
195     & '// WEST: no neighbor'
196     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
197     ENDIF
198     C o East communication details
199     IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
200     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
201     & '// EAST: ',
202     & 'Tile = ',tileNoE(I,J),
203     & ', Process = ',tilePidE(I,J),
204     & ', Comm = ',commName(tileCommModeE(I,J))
205     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
206     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
207     & '// ',
208     & ' bi = ',tileBiE(I,J),
209     & ', bj = ',tileBjE(I,J)
210     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
211     ELSE
212     WRITE(msgBuf,'(A)')
213     & '// EAST: no neighbor'
214     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
215     ENDIF
216     C o South communication method
217     IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
218     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
219     & '// SOUTH: ',
220     & 'Tile = ',tileNoS(I,J),
221     & ', Process = ',tilePidS(I,J),
222     & ', Comm = ',commName(tileCommModeS(I,J))
223     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
224     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
225     & '// ',
226     & ' bi = ',tileBiS(I,J),
227     & ', bj = ',tileBjS(I,J)
228     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
229     ELSE
230     WRITE(msgBuf,'(A)')
231     & '// SOUTH: no neighbor'
232     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
233     ENDIF
234     C o North communication method
235     IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
236     WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
237     & '// NORTH: ',
238     & 'Tile = ',tileNoN(I,J),
239     & ', Process = ',tilePidN(I,J),
240     & ', Comm = ',commName(tileCommModeN(I,J))
241     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
242     WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
243     & '// ',
244     & ' bi = ',tileBiN(I,J),
245     & ', bj = ',tileBjN(I,J)
246     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
247     ELSE
248     WRITE(msgBuf,'(A)')
249     & '// NORTH: no neighbor'
250     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
251 cnh 1.1 ENDIF
252     ENDDO
253     ENDDO
254 cnh 1.5 WRITE(msgBuf,'(A)') ' '
255     CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
256 cnh 1.1
257     RETURN
258     END

  ViewVC Help
Powered by ViewVC 1.1.22