/[MITgcm]/MITgcm/pkg/flt/exch_send_put_vec.F
ViewVC logotype

Contents of /MITgcm/pkg/flt/exch_send_put_vec.F

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


Revision 1.7 - (show annotations) (download)
Thu Mar 26 22:21:11 2009 UTC (15 years, 1 month ago) by cnh
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint62, checkpoint63, checkpoint63a, checkpoint63b, checkpoint62b, checkpoint61n, checkpoint61q, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.6: +9 -9 lines
Fixing comments that break code browser

1 C $Header: /u/u0/gcmpack/MITgcm/pkg/flt/exch_send_put_vec.F,v 1.6 2009/01/09 21:08:27 jmc Exp $
2 C $Name: $
3
4 #include "CPP_EEOPTIONS.h"
5 #undef DBUG_EXCH_VEC
6
7 C-- Contents
8 C-- o EXCH_RL_SEND_PUT_VEC_X
9 C-- o EXCH_RL_SEND_PUT_VEC_Y
10
11 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
12 CBOP 0
13 C !ROUTINE: EXCH_RL_SEND_PUT_VEC_X
14
15 C !INTERFACE:
16 SUBROUTINE EXCH_RL_SEND_PUT_VEC_X(
17 I arrayE, arrayW,
18 O bufRecE, bufRecW,
19 I myd1, myThid )
20 C !DESCRIPTION:
21 C *==========================================================*
22 C | SUBROUTINE EXCH_RL_SEND_PUT_VEC_X
23 C | o "Send" or "put" X edges for RL array.
24 C *==========================================================*
25 C | Routine that invokes actual message passing send or
26 C | direct "put" of data to update buffer in X direction
27 C *==========================================================*
28
29 C !USES:
30 IMPLICIT NONE
31
32 C == Global variables ==
33 #include "SIZE.h"
34 #include "EEPARAMS.h"
35 #include "EESUPPORT.h"
36 #include "EXCH.h"
37
38 C !INPUT/OUTPUT PARAMETERS:
39 C arrayE :: Input buffer array to send to Eastern Neighbour
40 C arrayW :: Input buffer array to send to Western Neighbour
41 C bufRecE :: buffer array to collect Eastern Neighbour values
42 C bufRecW :: buffer array to collect Western Neighbour values
43 C myd1 :: size
44 C myThid :: my Thread Id. number
45 INTEGER myd1
46 _RL arrayE(myd1,nSx,nSy), arrayW(myd1,nSx,nSy)
47 _RL bufRecE(myd1,nSx,nSy), bufRecW(myd1,nSx,nSy)
48 INTEGER myThid
49 CEOP
50
51 C !LOCAL VARIABLES:
52 C I :: Loop counters
53 C bi, bj :: tile indices
54 C biW, bjW :: West tile indices
55 C biE, bjE :: East tile indices
56 C theProc :: Variables used in message building
57 C theTag :: Variables used in message building
58 C theType :: Variables used in message building
59 C theSize :: Variables used in message building
60 C westCommMode :: variables holding type of communication
61 C eastCommMode :: a particular tile face uses.
62 INTEGER I
63 INTEGER bi, bj, biW, bjW, biE, bjE
64 INTEGER westCommMode
65 INTEGER eastCommMode
66 #ifdef ALLOW_USE_MPI
67 INTEGER theProc, theTag, theType, theSize, mpiRc
68 #endif
69 #ifdef DBUG_EXCH_VEC
70 INTEGER ioUnit
71 #endif
72
73 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
74 C-- Write data to exchange buffer
75 C Various actions are possible depending on the communication mode
76 C as follows:
77 C Mode Action
78 C -------- ---------------------------
79 C COMM_NONE Do nothing
80 C
81 C COMM_MSG Message passing communication ( e.g. MPI )
82 C Fill west send buffer from this tile.
83 C Send data with tag identifying tile and direction.
84 C Fill east send buffer from this tile.
85 C Send data with tag identifying tile and direction.
86 C
87 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
88 C Fill east receive buffer of west-neighbor tile
89 C Fill west receive buffer of east-neighbor tile
90 C Sync. memory
91 C Write data-ready Ack for east edge of west-neighbor
92 C tile
93 C Write data-ready Ack for west edge of east-neighbor
94 C tile
95 C Sync. memory
96
97 #ifdef DBUG_EXCH_VEC
98 ioUnit = errorMessageUnit
99 WRITE(ioUnit,'(A,2L5)')
100 & 'SEND_PUT_X: exchNeedsMemsync,exchUsesBarrier=',
101 & exchNeedsMemsync,exchUsesBarrier
102 #endif
103
104 DO bj=myByLo(myThid),myByHi(myThid)
105 DO bi=myBxLo(myThid),myBxHi(myThid)
106
107 westCommMode = _tileCommModeW(bi,bj)
108 eastCommMode = _tileCommModeE(bi,bj)
109 biE = _tileBiE(bi,bj)
110 bjE = _tileBjE(bi,bj)
111 biW = _tileBiW(bi,bj)
112 bjW = _tileBjW(bi,bj)
113
114 C o Send or Put west edge
115 IF ( westCommMode .EQ. COMM_MSG ) THEN
116 C Send the data
117 #ifdef ALLOW_USE_MPI
118 #ifndef ALWAYS_USE_MPI
119 IF ( usingMPI ) THEN
120 #endif
121 theProc = tilePidW(bi,bj)
122 theTag = _tileTagSendW(bi,bj)
123 theSize = myd1
124 theType = _MPI_TYPE_RL
125 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
126 #ifdef DBUG_EXCH_VEC
127 write(ioUnit,'(A,7I5,I8)') 'qq1xW: ',myProcId,bi,bj,
128 & theProc,theTag, exchNReqsX(1,bi,bj),
129 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), theSize
130 #endif
131 CALL MPI_Isend(arrayW(1,bi,bj), theSize, theType,
132 & theProc, theTag, MPI_COMM_MODEL,
133 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc)
134 #ifndef ALWAYS_USE_MPI
135 ENDIF
136 #endif
137 #endif /* ALLOW_USE_MPI */
138 eastRecvAck(1,biW,bjW) = 1
139 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
140 c write(0,*) 'SEND_PUT_VEC_X: copy E:',biW,bjW,' <- W:',bi,bj
141 DO I=1,myd1
142 bufRecE(I,biW,bjW) = arrayW(I,bi,bj)
143 ENDDO
144 ELSEIF ( westCommMode .NE. COMM_NONE ) THEN
145 STOP ' S/R EXCH: Invalid commW mode.'
146 ENDIF
147
148 C o Send or Put east edge
149 IF ( eastCommMode .EQ. COMM_MSG ) THEN
150 C Send the data
151 #ifdef ALLOW_USE_MPI
152 #ifndef ALWAYS_USE_MPI
153 IF ( usingMPI ) THEN
154 #endif
155 theProc = tilePidE(bi,bj)
156 theTag = _tileTagSendE(bi,bj)
157 theSize = myd1
158 theType = _MPI_TYPE_RL
159 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
160 #ifdef DBUG_EXCH_VEC
161 c if (theProc .eq. 2 .or. theProc .eq. 4) then
162 c if (arrayE(1,bi,bj) .ne. 0.) then
163 write(ioUnit,'(A,7I5,I8)') 'qq1xE: ',myProcId,bi,bj,
164 & theProc,theTag, exchNReqsX(1,bi,bj),
165 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), theSize
166 c endif
167 c endif
168 #endif
169 CALL MPI_Isend(arrayE(1,bi,bj), theSize, theType,
170 & theProc, theTag, MPI_COMM_MODEL,
171 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc)
172 #ifndef ALWAYS_USE_MPI
173 ENDIF
174 #endif
175 #endif /* ALLOW_USE_MPI */
176 westRecvAck(1,biE,bjE) = 1
177 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
178 c write(0,*) 'SEND_PUT_VEC_X: copy W:',biE,bjE,' <- E:',bi,bj
179 DO I=1,myd1
180 bufRecW(I,biE,bjE) = arrayE(I,bi,bj)
181 ENDDO
182 ELSEIF ( eastCommMode .NE. COMM_NONE ) THEN
183 STOP ' S/R EXCH: Invalid commE mode.'
184 ENDIF
185
186 ENDDO
187 ENDDO
188
189 C-- Signal completetion ( making sure system-wide memory state is
190 C-- consistent ).
191
192 C ** NOTE ** We are relying on being able to produce strong-ordered
193 C memory semantics here. In other words we assume that there is a
194 C mechanism which can ensure that by the time the Ack is seen the
195 C overlap region data that will be exchanged is up to date.
196 IF ( exchNeedsMemSync ) CALL MEMSYNC
197
198 DO bj=myByLo(myThid),myByHi(myThid)
199 DO bi=myBxLo(myThid),myBxHi(myThid)
200 biE = _tileBiE(bi,bj)
201 bjE = _tileBjE(bi,bj)
202 biW = _tileBiW(bi,bj)
203 bjW = _tileBjW(bi,bj)
204 westCommMode = _tileCommModeW(bi,bj)
205 eastCommMode = _tileCommModeE(bi,bj)
206 IF ( westCommMode .EQ. COMM_PUT ) eastRecvAck(1,biW,bjW) = 1
207 IF ( eastCommMode .EQ. COMM_PUT ) westRecvAck(1,biE,bjE) = 1
208 IF ( westCommMode .EQ. COMM_GET ) eastRecvAck(1,biW,bjW) = 1
209 IF ( eastCommMode .EQ. COMM_GET ) westRecvAck(1,biE,bjE) = 1
210 ENDDO
211 ENDDO
212
213 C-- Make sure "ack" setting is seen system-wide.
214 C Here strong-ordering is not an issue but we want to make
215 C sure that processes that might spin on the above Ack settings
216 C will see the setting.
217 C ** NOTE ** On some machines we wont spin on the Ack setting
218 C ( particularly the T90 ), instead we will use s system barrier.
219 C On the T90 the system barrier is very fast and switches out the
220 C thread while it waits. On most machines the system barrier
221 C is much too slow and if we own the machine and have one thread
222 C per process preemption is not a problem.
223 IF ( exchNeedsMemSync ) CALL MEMSYNC
224
225 RETURN
226 END
227
228 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
229 CBOP 0
230 C !ROUTINE: EXCH_RL_SEND_PUT_VEC_Y
231
232 C !INTERFACE:
233 SUBROUTINE EXCH_RL_SEND_PUT_VEC_Y(
234 I arrayN, arrayS,
235 O bufRecN, bufRecS,
236 I myd1, myThid )
237 C !DESCRIPTION:
238 C *==========================================================*
239 C | SUBROUTINE EXCH_RL_SEND_PUT_VEC_Y
240 C | o "Send" or "put" Y edges for RL array.
241 C *==========================================================*
242 C | Routine that invokes actual message passing send or
243 C | direct "put" of data to update buffer in Y direction
244 C *==========================================================*
245
246 C !USES:
247 IMPLICIT NONE
248
249 C == Global variables ==
250 #include "SIZE.h"
251 #include "EEPARAMS.h"
252 #include "EESUPPORT.h"
253 #include "EXCH.h"
254
255 C !INPUT/OUTPUT PARAMETERS:
256 C arrayN :: buffer array to collect Northern Neighbour values
257 C arrayS :: buffer array to collect Southern Neighbour values
258 C myd1 :: size
259 C myThid :: my Thread Id. number
260 C arrayN :: Input buffer array to send to Northern Neighbour
261 C arrayS :: Input buffer array to send to Southern Neighbour
262 C bufRecN :: buffer array to collect Northern Neighbour values
263 C bufRecS :: buffer array to collect Southern Neighbour values
264 C myd1 :: size
265 C myThid :: my Thread Id. number
266 INTEGER myd1
267 _RL arrayN(myd1,nSx,nSy), arrayS(myd1,nSx,nSy)
268 _RL bufRecN(myd1,nSx,nSy), bufRecS(myd1,nSx,nSy)
269 INTEGER myThid
270 CEOP
271
272 C !LOCAL VARIABLES:
273 C I :: Loop index
274 C bi, bj :: tile indices
275 C biS, bjS :: South tile indices
276 C biN, bjN :: North tile indices
277 C theProc :: Variables used in message building
278 C theTag :: Variables used in message building
279 C theType :: Variables used in message building
280 C theSize :: Variables used in message building
281 C southCommMode :: variables holding type of communication
282 C northCommMode :: a particular tile face uses.
283 INTEGER I
284 INTEGER bi, bj, biS, bjS, biN, bjN
285 INTEGER southCommMode
286 INTEGER northCommMode
287 #ifdef ALLOW_USE_MPI
288 INTEGER theProc, theTag, theType, theSize, mpiRc
289 #endif
290 #ifdef DBUG_EXCH_VEC
291 INTEGER ioUnit
292 #endif
293
294 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
295 C-- Write data to exchange buffer
296 C Various actions are possible depending on the communication mode
297 C as follows:
298 C Mode Action
299 C -------- ---------------------------
300 C COMM_NONE Do nothing
301 C
302 C COMM_MSG Message passing communication ( e.g. MPI )
303 C Fill west send buffer from this tile.
304 C Send data with tag identifying tile and direction.
305 C Fill east send buffer from this tile.
306 C Send data with tag identifying tile and direction.
307 C
308 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
309 C Fill east receive buffer of south-neighbor tile
310 C Fill west receive buffer of north-neighbor tile
311 C Sync. memory
312 C Write data-ready Ack for east edge of south-neighbor
313 C tile
314 C Write data-ready Ack for west edge of north-neighbor
315 C tile
316 C Sync. memory
317
318 #ifdef DBUG_EXCH_VEC
319 ioUnit = errorMessageUnit
320 #endif
321
322 DO bj=myByLo(myThid),myByHi(myThid)
323 DO bi=myBxLo(myThid),myBxHi(myThid)
324
325 southCommMode = _tileCommModeS(bi,bj)
326 northCommMode = _tileCommModeN(bi,bj)
327 biN = _tileBiN(bi,bj)
328 bjN = _tileBjN(bi,bj)
329 biS = _tileBiS(bi,bj)
330 bjS = _tileBjS(bi,bj)
331
332 C o Send or Put south edge
333 IF ( southCommMode .EQ. COMM_MSG ) THEN
334 C Send the data
335 #ifdef ALLOW_USE_MPI
336 #ifndef ALWAYS_USE_MPI
337 IF ( usingMPI ) THEN
338 #endif
339 theProc = tilePidS(bi,bj)
340 theTag = _tileTagSendS(bi,bj)
341 theSize = myd1
342 theType = _MPI_TYPE_RL
343 exchNReqsY(1,bi,bj) = exchNReqsY(1,bi,bj)+1
344 CALL MPI_Isend(arrayS(1,bi,bj), theSize, theType,
345 & theProc, theTag, MPI_COMM_MODEL,
346 & exchReqIdY(exchNReqsY(1,bi,bj),1,bi,bj), mpiRc)
347 #ifndef ALWAYS_USE_MPI
348 ENDIF
349 #endif
350 #endif /* ALLOW_USE_MPI */
351 northRecvAck(1,biS,bjS) = 1
352 ELSEIF ( southCommMode .EQ. COMM_PUT ) THEN
353 c write(0,*) 'SEND_PUT_VEC_Y: copy N:',biS,bjS,' <- S:',bi,bj
354 DO I=1,myd1
355 bufRecN(I,biS,bjS) = arrayS(I,bi,bj)
356 ENDDO
357 ELSEIF ( southCommMode .NE. COMM_NONE ) THEN
358 STOP ' S/R EXCH: Invalid commS mode.'
359 ENDIF
360
361 C o Send or Put north edge
362 IF ( northCommMode .EQ. COMM_MSG ) THEN
363 C Send the data
364 #ifdef ALLOW_USE_MPI
365 #ifndef ALWAYS_USE_MPI
366 IF ( usingMPI ) THEN
367 #endif
368 theProc = tilePidN(bi,bj)
369 theTag = _tileTagSendN(bi,bj)
370 theSize = myd1
371 theType = _MPI_TYPE_RL
372 exchNReqsY(1,bi,bj) = exchNReqsY(1,bi,bj)+1
373 CALL MPI_Isend(arrayN(1,bi,bj), theSize, theType,
374 & theProc, theTag, MPI_COMM_MODEL,
375 & exchReqIdY(exchNReqsY(1,bi,bj),1,bi,bj), mpiRc)
376 #ifndef ALWAYS_USE_MPI
377 ENDIF
378 #endif
379 #endif /* ALLOW_USE_MPI */
380 southRecvAck(1,biN,bjN) = 1
381 ELSEIF ( northCommMode .EQ. COMM_PUT ) THEN
382 c write(0,*) 'SEND_PUT_VEC_Y: copy S:',biN,bjN,' <- N:',bi,bj
383 DO I=1,myd1
384 bufRecS(I,biN,bjN) = arrayN(I,bi,bj)
385 ENDDO
386 ELSEIF ( northCommMode .NE. COMM_NONE ) THEN
387 STOP ' S/R EXCH: Invalid commN mode.'
388 ENDIF
389
390 ENDDO
391 ENDDO
392
393 C-- Signal completetion ( making sure system-wide memory state is
394 C-- consistent ).
395
396 C ** NOTE ** We are relying on being able to produce strong-ordered
397 C memory semantics here. In other words we assume that there is a
398 C mechanism which can ensure that by the time the Ack is seen the
399 C overlap region data that will be exchanged is up to date.
400 IF ( exchNeedsMemSync ) CALL MEMSYNC
401
402 DO bj=myByLo(myThid),myByHi(myThid)
403 DO bi=myBxLo(myThid),myBxHi(myThid)
404 biN = _tileBiN(bi,bj)
405 bjN = _tileBjN(bi,bj)
406 biS = _tileBiS(bi,bj)
407 bjS = _tileBjS(bi,bj)
408 southCommMode = _tileCommModeS(bi,bj)
409 northCommMode = _tileCommModeN(bi,bj)
410 IF ( southCommMode .EQ. COMM_PUT ) northRecvAck(1,biS,bjS) = 1
411 IF ( northCommMode .EQ. COMM_PUT ) southRecvAck(1,biN,bjN) = 1
412 IF ( southCommMode .EQ. COMM_GET ) northRecvAck(1,biS,bjS) = 1
413 IF ( northCommMode .EQ. COMM_GET ) southRecvAck(1,biN,bjN) = 1
414 ENDDO
415 ENDDO
416
417 C-- Make sure "ack" setting is seen system-wide.
418 C Here strong-ordering is not an issue but we want to make
419 C sure that processes that might spin on the above Ack settings
420 C will see the setting.
421 C ** NOTE ** On some machines we wont spin on the Ack setting
422 C ( particularly the T90 ), instead we will use s system barrier.
423 C On the T90 the system barrier is very fast and switches out the
424 C thread while it waits. On most machines the system barrier
425 C is much too slow and if we own the machine and have one thread
426 C per process preemption is not a problem.
427 IF ( exchNeedsMemSync ) CALL MEMSYNC
428
429 RETURN
430 END

  ViewVC Help
Powered by ViewVC 1.1.22