/[MITgcm]/MITgcm/eesupp/src/exch_rx_send_put_x.template
ViewVC logotype

Contents of /MITgcm/eesupp/src/exch_rx_send_put_x.template

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


Revision 1.9 - (show annotations) (download)
Fri Mar 28 18:39:54 2008 UTC (16 years, 3 months ago) by utke
Branch: MAIN
Changes since 1.8: +9 -5 lines
handle request book keeping within the wrapper

1 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_send_put_x.template,v 1.8 2008/03/18 21:34:01 utke Exp $
2 C $Name: $
3 #include "CPP_EEOPTIONS.h"
4
5 CBOP
6
7 C !ROUTINE: EXCH_RX_SEND_PUT_X
8
9 C !INTERFACE:
10 SUBROUTINE EXCH_RX_SEND_PUT_X( array,
11 I myOLw, myOLe, myOLs, myOLn, myNz,
12 I exchWidthX, exchWidthY,
13 I thesimulationMode, thecornerMode, myThid )
14 IMPLICIT NONE
15 C !DESCRIPTION:
16 C *==========================================================*
17 C | SUBROUTINE EXCH_RX_SEND_PUT_X
18 C | o "Send" or "put" X edges for RX array.
19 C *==========================================================*
20 C | Routine that invokes actual message passing send or
21 C | direct "put" of data to update X faces of an XY[R] array.
22 C *==========================================================*
23
24 C !USES:
25 C == Global variables ==
26 #include "SIZE.h"
27 #include "EEPARAMS.h"
28 #include "EESUPPORT.h"
29 #include "EXCH.h"
30
31 C !INPUT/OUTPUT PARAMETERS:
32 C == Routine arguments ==
33 C array :: Array with edges to exchange.
34 C myOLw :: West, East, North and South overlap region sizes.
35 C myOLe
36 C myOLn
37 C myOLs
38 C exchWidthX :: Width of data region exchanged.
39 C exchWidthY
40 C theSimulationMode :: Forward or reverse mode exchange ( provides
41 C support for adjoint integration of code. )
42 C theCornerMode :: Flag indicating whether corner updates are
43 C needed.
44 C myThid :: Thread number of this instance of S/R EXCH...
45 C eBl :: Edge buffer level
46 INTEGER myOLw
47 INTEGER myOLe
48 INTEGER myOLs
49 INTEGER myOLn
50 INTEGER myNz
51 _RX array(1-myOLw:sNx+myOLe,
52 & 1-myOLs:sNy+myOLn,
53 & myNZ, nSx, nSy)
54 INTEGER exchWidthX
55 INTEGER exchWidthY
56 INTEGER theSimulationMode
57 INTEGER theCornerMode
58 INTEGER myThid
59
60 C !LOCAL VARIABLES:
61 C == Local variables ==
62 C I, J, K, iMin, iMax, iB :: Loop counters and extents
63 C bi, bj
64 C biW, bjW :: West tile indices
65 C biE, bjE :: East tile indices
66 C eBl :: Current exchange buffer level
67 C theProc, theTag, theType, :: Variables used in message building
68 C theSize
69 C westCommMode :: Working variables holding type
70 C eastCommMode of communication a particular
71 C tile face uses.
72 INTEGER I, J, K, iMin, iMax, iB
73 INTEGER bi, bj, biW, bjW, biE, bjE
74 INTEGER eBl
75 INTEGER westCommMode
76 INTEGER eastCommMode
77
78 #ifdef ALLOW_USE_MPI
79 INTEGER theProc, theTag, theType, theSize, mpiRc
80 # ifdef ALLOW_AUTODIFF_OPENAD
81 INTEGER mpiStatus(MPI_STATUS_SIZE)
82 # endif
83 #endif
84 C-- Write data to exchange buffer
85 C Various actions are possible depending on the communication mode
86 C as follows:
87 C Mode Action
88 C -------- ---------------------------
89 C COMM_NONE Do nothing
90 C
91 C COMM_MSG Message passing communication ( e.g. MPI )
92 C Fill west send buffer from this tile.
93 C Send data with tag identifying tile and direction.
94 C Fill east send buffer from this tile.
95 C Send data with tag identifying tile and direction.
96 C
97 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
98 C Fill east receive buffer of west-neighbor tile
99 C Fill west receive buffer of east-neighbor tile
100 C Sync. memory
101 C Write data-ready Ack for east edge of west-neighbor
102 C tile
103 C Write data-ready Ack for west edge of east-neighbor
104 C tile
105 C Sync. memory
106 C
107 CEOP
108
109 INTEGER myBxLoSave(MAX_NO_THREADS)
110 INTEGER myBxHiSave(MAX_NO_THREADS)
111 INTEGER myByLoSave(MAX_NO_THREADS)
112 INTEGER myByHiSave(MAX_NO_THREADS)
113 LOGICAL doingSingleThreadedComms
114
115 doingSingleThreadedComms = .FALSE.
116 #ifdef ALLOW_USE_MPI
117 #ifndef ALWAYS_USE_MPI
118 IF ( usingMPI ) THEN
119 #endif
120 C Set default behavior to have MPI comms done by a single thread.
121 C Most MPI implementations don't support concurrent comms from
122 C several threads.
123 IF ( nThreads .GT. 1 ) THEN
124 _BARRIER
125 _BEGIN_MASTER( myThid )
126 DO I=1,nThreads
127 myBxLoSave(I) = myBxLo(I)
128 myBxHiSave(I) = myBxHi(I)
129 myByLoSave(I) = myByLo(I)
130 myByHiSave(I) = myByHi(I)
131 ENDDO
132 C Comment out loop below and myB[xy][Lo|Hi](1) settings below
133 C if you want to get multi-threaded MPI comms.
134 DO I=1,nThreads
135 myBxLo(I) = 0
136 myBxHi(I) = -1
137 myByLo(I) = 0
138 myByHi(I) = -1
139 ENDDO
140 myBxLo(1) = 1
141 myBxHi(1) = nSx
142 myByLo(1) = 1
143 myByHi(1) = nSy
144 doingSingleThreadedComms = .TRUE.
145 _END_MASTER( myThid )
146 _BARRIER
147 ENDIF
148 #ifndef ALWAYS_USE_MPI
149 ENDIF
150 #endif
151 #endif
152
153 #ifdef ALLOW_AUTODIFF_OPENAD
154 # ifdef ALLOW_USE_MPI
155 DO bj=myByLo(myThid),myByHi(myThid)
156 DO bi=myBxLo(myThid),myBxHi(myThid)
157
158 # ifndef ALWAYS_USE_MPI
159 IF ( usingMPI ) THEN
160 # endif
161 CALL ampi_awaitall (
162 & exchNReqsX(1,bi,bj) ,
163 & exchReqIdX(1,1,bi,bj) ,
164 & mpiStatus ,
165 & mpiRC )
166 # ifndef ALWAYS_USE_MPI
167 ENDIF
168 # endif
169 ENDDO
170 ENDDO
171 # endif
172 #endif
173 DO bj=myByLo(myThid),myByHi(myThid)
174 DO bi=myBxLo(myThid),myBxHi(myThid)
175
176 ebL = exchangeBufLevel(1,bi,bj)
177 westCommMode = _tileCommModeW(bi,bj)
178 eastCommMode = _tileCommModeE(bi,bj)
179 biE = _tileBiE(bi,bj)
180 bjE = _tileBjE(bi,bj)
181 biW = _tileBiW(bi,bj)
182 bjW = _tileBjW(bi,bj)
183
184 C o Send or Put west edge
185 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
186 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
187 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
188
189 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
190 iMin = 1
191 iMax = 1+exchWidthX-1
192 IF ( westCommMode .EQ. COMM_MSG ) THEN
193 iB = 0
194 DO K=1,myNz
195 DO J=1,sNy
196 DO I=iMin,iMax
197 iB = iB + 1
198 westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
199 ENDDO
200 ENDDO
201 ENDDO
202 C Send the data
203 #ifdef ALLOW_USE_MPI
204 #ifndef ALWAYS_USE_MPI
205 IF ( usingMPI ) THEN
206 #endif
207 theProc = tilePidW(bi,bj)
208 theTag = _tileTagSendW(bi,bj)
209 theSize = iB
210 theType = _MPI_TYPE_RX
211 # ifndef ALLOW_AUTODIFF_OPENAD
212 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
213 CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
214 & theProc, theTag, MPI_COMM_MODEL,
215 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
216 # else
217 CALL ampi_isend_RX(
218 & westSendBuf_RX(1,eBl,bi,bj),
219 & theSize,
220 & theType,
221 & theProc,
222 & theTag,
223 & MPI_COMM_MODEL,
224 & exchReqIdX(exchNReqsX(1,bi,bj)+1,1,bi,bj),
225 & exchNReqsX(1,bi,bj),
226 & mpiStatus ,
227 & mpiRc )
228 # endif /* ALLOW_AUTODIFF_OPENAD */
229 #ifndef ALWAYS_USE_MPI
230 ENDIF
231 #endif
232 #endif /* ALLOW_USE_MPI */
233 eastRecvAck(eBl,biW,bjW) = 1
234 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
235 iB = 0
236 DO K=1,myNz
237 DO J=1,sNy
238 DO I=iMin,iMax
239 iB = iB + 1
240 eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
241 ENDDO
242 ENDDO
243 ENDDO
244 ELSEIF ( westCommMode .NE. COMM_NONE
245 & .AND. westCommMode .NE. COMM_GET ) THEN
246 STOP ' S/R EXCH: Invalid commW mode.'
247 ENDIF
248
249 C o Send or Put east edge
250 iMin = sNx-exchWidthX+1
251 iMax = sNx
252 IF ( eastCommMode .EQ. COMM_MSG ) THEN
253 iB = 0
254 DO K=1,myNz
255 DO J=1,sNy
256 DO I=iMin,iMax
257 iB = iB + 1
258 eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
259 ENDDO
260 ENDDO
261 ENDDO
262 C Send the data
263 #ifdef ALLOW_USE_MPI
264 #ifndef ALWAYS_USE_MPI
265 IF ( usingMPI ) THEN
266 #endif
267 theProc = tilePidE(bi,bj)
268 theTag = _tileTagSendE(bi,bj)
269 theSize = iB
270 theType = _MPI_TYPE_RX
271 # ifndef ALLOW_AUTODIFF_OPENAD
272 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
273 CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
274 & theProc, theTag, MPI_COMM_MODEL,
275 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
276 # else
277 CALL ampi_isend_RX(
278 & eastSendBuf_RX(1,eBl,bi,bj) ,
279 & theSize ,
280 & theType ,
281 & theProc ,
282 & theTag ,
283 & MPI_COMM_MODEL ,
284 & exchReqIdX(exchNReqsX(1,bi,bj)+1,1,bi,bj) ,
285 & exchNReqsX(1,bi,bj),
286 & mpiStatus ,
287 & mpiRc )
288 # endif /* ALLOW_AUTODIFF_OPENAD */
289 #ifndef ALWAYS_USE_MPI
290 ENDIF
291 #endif
292 #endif /* ALLOW_USE_MPI */
293 westRecvAck(eBl,biE,bjE) = 1
294 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
295 iB = 0
296 DO K=1,myNz
297 DO J=1,sNy
298 DO I=iMin,iMax
299 iB = iB + 1
300 westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
301 ENDDO
302 ENDDO
303 ENDDO
304 ELSEIF ( eastCommMode .NE. COMM_NONE
305 & .AND. eastCommMode .NE. COMM_GET ) THEN
306 STOP ' S/R EXCH: Invalid commE mode.'
307 ENDIF
308 #ifndef ALLOW_AUTODIFF_OPENAD
309
310 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
311 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
312 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
313 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
314 iMin = 1-exchWidthX
315 iMax = 0
316 IF ( westCommMode .EQ. COMM_MSG ) THEN
317 iB = 0
318 DO K=1,myNz
319 DO J=1,sNy
320 DO I=iMin,iMax
321 iB = iB + 1
322 westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
323 array(I,J,K,bi,bj) = 0.0
324 ENDDO
325 ENDDO
326 ENDDO
327 C Send the data
328 #ifdef ALLOW_USE_MPI
329 #ifndef ALWAYS_USE_MPI
330 IF ( usingMPI ) THEN
331 #endif
332 theProc = tilePidW(bi,bj)
333 theTag = _tileTagSendW(bi,bj)
334 theSize = iB
335 theType = _MPI_TYPE_RX
336 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
337 CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
338 & theProc, theTag, MPI_COMM_MODEL,
339 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
340 #ifndef ALWAYS_USE_MPI
341 ENDIF
342 #endif
343 #endif /* ALLOW_USE_MPI */
344 eastRecvAck(eBl,biW,bjW) = 1
345 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
346 iB = 0
347 DO K=1,myNz
348 DO J=1,sNy
349 DO I=iMin,iMax
350 iB = iB + 1
351 eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
352 array(I,J,K,bi,bj) = 0.0
353 ENDDO
354 ENDDO
355 ENDDO
356 ELSEIF ( westCommMode .NE. COMM_NONE
357 & .AND. westCommMode .NE. COMM_GET ) THEN
358 STOP ' S/R EXCH: Invalid commW mode.'
359 ENDIF
360
361 C o Send or Put east edge
362 iMin = sNx+1
363 iMax = sNx+exchWidthX
364 IF ( eastCommMode .EQ. COMM_MSG ) THEN
365 iB = 0
366 DO K=1,myNz
367 DO J=1,sNy
368 DO I=iMin,iMax
369 iB = iB + 1
370 eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
371 array(I,J,K,bi,bj) = 0.0
372 ENDDO
373 ENDDO
374 ENDDO
375 C Send the data
376 #ifdef ALLOW_USE_MPI
377 #ifndef ALWAYS_USE_MPI
378 IF ( usingMPI ) THEN
379 #endif
380 theProc = tilePidE(bi,bj)
381 theTag = _tileTagSendE(bi,bj)
382 theSize = iB
383 theType = _MPI_TYPE_RX
384 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
385 CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
386 & theProc, theTag, MPI_COMM_MODEL,
387 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
388 #ifndef ALWAYS_USE_MPI
389 ENDIF
390 #endif
391 #endif /* ALLOW_USE_MPI */
392 westRecvAck(eBl,biE,bjE) = 1
393 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
394 iB = 0
395 DO K=1,myNz
396 DO J=1,sNy
397 DO I=iMin,iMax
398 iB = iB + 1
399 westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
400 array(I,J,K,bi,bj) = 0.0
401 ENDDO
402 ENDDO
403 ENDDO
404 ELSEIF ( eastCommMode .NE. COMM_NONE
405 & .AND. eastCommMode .NE. COMM_GET ) THEN
406 STOP ' S/R EXCH: Invalid commE mode.'
407 ENDIF
408
409 #endif /* ALLOW_AUTODIFF_OPENAD */
410 ENDIF
411
412 ENDDO
413 ENDDO
414
415 C-- Signal completetion ( making sure system-wide memory state is
416 C-- consistent ).
417
418 C ** NOTE ** We are relying on being able to produce strong-ordered
419 C memory semantics here. In other words we assume that there is a
420 C mechanism which can ensure that by the time the Ack is seen the
421 C overlap region data that will be exchanged is up to date.
422 IF ( exchNeedsMemSync ) CALL MEMSYNC
423
424 DO bj=myByLo(myThid),myByHi(myThid)
425 DO bi=myBxLo(myThid),myBxHi(myThid)
426 ebL = exchangeBufLevel(1,bi,bj)
427 biE = _tileBiE(bi,bj)
428 bjE = _tileBjE(bi,bj)
429 biW = _tileBiW(bi,bj)
430 bjW = _tileBjW(bi,bj)
431 westCommMode = _tileCommModeW(bi,bj)
432 eastCommMode = _tileCommModeE(bi,bj)
433 IF ( westCommMode.EQ.COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1
434 IF ( eastCommMode.EQ.COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1
435 IF ( westCommMode.EQ.COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1
436 IF ( eastCommMode.EQ.COMM_GET ) westRecvAck(eBl,biE,bjE) = 1
437 ENDDO
438 ENDDO
439
440 C-- Make sure "ack" setting is seen system-wide.
441 C Here strong-ordering is not an issue but we want to make
442 C sure that processes that might spin on the above Ack settings
443 C will see the setting.
444 C ** NOTE ** On some machines we wont spin on the Ack setting
445 C ( particularly the T90 ), instead we will use s system barrier.
446 C On the T90 the system barrier is very fast and switches out the
447 C thread while it waits. On most machines the system barrier
448 C is much too slow and if we own the machine and have one thread
449 C per process preemption is not a problem.
450 IF ( exchNeedsMemSync ) CALL MEMSYNC
451
452 _BARRIER
453 IF ( doingSingleThreadedComms ) THEN
454 C Restore saved settings that were stored to allow
455 C single thred comms.
456 _BEGIN_MASTER(myThid)
457 DO I=1,nThreads
458 myBxLo(I) = myBxLoSave(I)
459 myBxHi(I) = myBxHiSave(I)
460 myByLo(I) = myByLoSave(I)
461 myByHi(I) = myByHiSave(I)
462 ENDDO
463 _END_MASTER(myThid)
464 ENDIF
465 _BARRIER
466
467 RETURN
468 END

  ViewVC Help
Powered by ViewVC 1.1.22