/[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.8 - (show annotations) (download)
Tue Mar 18 21:34:01 2008 UTC (16 years, 3 months ago) by utke
Branch: MAIN
Changes since 1.7: +51 -1 lines
aMPI prototype

1 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_send_put_x.template,v 1.7 2008/02/20 20:29:54 jmc 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 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
212 # ifndef ALLOW_AUTODIFF_OPENAD
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,bi,bj),
225 & mpiRc )
226 # endif /* ALLOW_AUTODIFF_OPENAD */
227 #ifndef ALWAYS_USE_MPI
228 ENDIF
229 #endif
230 #endif /* ALLOW_USE_MPI */
231 eastRecvAck(eBl,biW,bjW) = 1
232 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
233 iB = 0
234 DO K=1,myNz
235 DO J=1,sNy
236 DO I=iMin,iMax
237 iB = iB + 1
238 eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
239 ENDDO
240 ENDDO
241 ENDDO
242 ELSEIF ( westCommMode .NE. COMM_NONE
243 & .AND. westCommMode .NE. COMM_GET ) THEN
244 STOP ' S/R EXCH: Invalid commW mode.'
245 ENDIF
246
247 C o Send or Put east edge
248 iMin = sNx-exchWidthX+1
249 iMax = sNx
250 IF ( eastCommMode .EQ. COMM_MSG ) THEN
251 iB = 0
252 DO K=1,myNz
253 DO J=1,sNy
254 DO I=iMin,iMax
255 iB = iB + 1
256 eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
257 ENDDO
258 ENDDO
259 ENDDO
260 C Send the data
261 #ifdef ALLOW_USE_MPI
262 #ifndef ALWAYS_USE_MPI
263 IF ( usingMPI ) THEN
264 #endif
265 theProc = tilePidE(bi,bj)
266 theTag = _tileTagSendE(bi,bj)
267 theSize = iB
268 theType = _MPI_TYPE_RX
269 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
270 # ifndef ALLOW_AUTODIFF_OPENAD
271 CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
272 & theProc, theTag, MPI_COMM_MODEL,
273 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
274 # else
275 CALL ampi_isend_RX(
276 & eastSendBuf_RX(1,eBl,bi,bj) ,
277 & theSize ,
278 & theType ,
279 & theProc ,
280 & theTag ,
281 & MPI_COMM_MODEL ,
282 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj) ,
283 & mpiRc )
284 # endif /* ALLOW_AUTODIFF_OPENAD */
285 #ifndef ALWAYS_USE_MPI
286 ENDIF
287 #endif
288 #endif /* ALLOW_USE_MPI */
289 westRecvAck(eBl,biE,bjE) = 1
290 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
291 iB = 0
292 DO K=1,myNz
293 DO J=1,sNy
294 DO I=iMin,iMax
295 iB = iB + 1
296 westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
297 ENDDO
298 ENDDO
299 ENDDO
300 ELSEIF ( eastCommMode .NE. COMM_NONE
301 & .AND. eastCommMode .NE. COMM_GET ) THEN
302 STOP ' S/R EXCH: Invalid commE mode.'
303 ENDIF
304 #ifndef ALLOW_AUTODIFF_OPENAD
305
306 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
307 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
308 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
309 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
310 iMin = 1-exchWidthX
311 iMax = 0
312 IF ( westCommMode .EQ. COMM_MSG ) THEN
313 iB = 0
314 DO K=1,myNz
315 DO J=1,sNy
316 DO I=iMin,iMax
317 iB = iB + 1
318 westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
319 array(I,J,K,bi,bj) = 0.0
320 ENDDO
321 ENDDO
322 ENDDO
323 C Send the data
324 #ifdef ALLOW_USE_MPI
325 #ifndef ALWAYS_USE_MPI
326 IF ( usingMPI ) THEN
327 #endif
328 theProc = tilePidW(bi,bj)
329 theTag = _tileTagSendW(bi,bj)
330 theSize = iB
331 theType = _MPI_TYPE_RX
332 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
333 CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
334 & theProc, theTag, MPI_COMM_MODEL,
335 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
336 #ifndef ALWAYS_USE_MPI
337 ENDIF
338 #endif
339 #endif /* ALLOW_USE_MPI */
340 eastRecvAck(eBl,biW,bjW) = 1
341 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
342 iB = 0
343 DO K=1,myNz
344 DO J=1,sNy
345 DO I=iMin,iMax
346 iB = iB + 1
347 eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
348 array(I,J,K,bi,bj) = 0.0
349 ENDDO
350 ENDDO
351 ENDDO
352 ELSEIF ( westCommMode .NE. COMM_NONE
353 & .AND. westCommMode .NE. COMM_GET ) THEN
354 STOP ' S/R EXCH: Invalid commW mode.'
355 ENDIF
356
357 C o Send or Put east edge
358 iMin = sNx+1
359 iMax = sNx+exchWidthX
360 IF ( eastCommMode .EQ. COMM_MSG ) THEN
361 iB = 0
362 DO K=1,myNz
363 DO J=1,sNy
364 DO I=iMin,iMax
365 iB = iB + 1
366 eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
367 array(I,J,K,bi,bj) = 0.0
368 ENDDO
369 ENDDO
370 ENDDO
371 C Send the data
372 #ifdef ALLOW_USE_MPI
373 #ifndef ALWAYS_USE_MPI
374 IF ( usingMPI ) THEN
375 #endif
376 theProc = tilePidE(bi,bj)
377 theTag = _tileTagSendE(bi,bj)
378 theSize = iB
379 theType = _MPI_TYPE_RX
380 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
381 CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
382 & theProc, theTag, MPI_COMM_MODEL,
383 & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
384 #ifndef ALWAYS_USE_MPI
385 ENDIF
386 #endif
387 #endif /* ALLOW_USE_MPI */
388 westRecvAck(eBl,biE,bjE) = 1
389 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
390 iB = 0
391 DO K=1,myNz
392 DO J=1,sNy
393 DO I=iMin,iMax
394 iB = iB + 1
395 westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
396 array(I,J,K,bi,bj) = 0.0
397 ENDDO
398 ENDDO
399 ENDDO
400 ELSEIF ( eastCommMode .NE. COMM_NONE
401 & .AND. eastCommMode .NE. COMM_GET ) THEN
402 STOP ' S/R EXCH: Invalid commE mode.'
403 ENDIF
404
405 #endif /* ALLOW_AUTODIFF_OPENAD */
406 ENDIF
407
408 ENDDO
409 ENDDO
410
411 C-- Signal completetion ( making sure system-wide memory state is
412 C-- consistent ).
413
414 C ** NOTE ** We are relying on being able to produce strong-ordered
415 C memory semantics here. In other words we assume that there is a
416 C mechanism which can ensure that by the time the Ack is seen the
417 C overlap region data that will be exchanged is up to date.
418 IF ( exchNeedsMemSync ) CALL MEMSYNC
419
420 DO bj=myByLo(myThid),myByHi(myThid)
421 DO bi=myBxLo(myThid),myBxHi(myThid)
422 ebL = exchangeBufLevel(1,bi,bj)
423 biE = _tileBiE(bi,bj)
424 bjE = _tileBjE(bi,bj)
425 biW = _tileBiW(bi,bj)
426 bjW = _tileBjW(bi,bj)
427 westCommMode = _tileCommModeW(bi,bj)
428 eastCommMode = _tileCommModeE(bi,bj)
429 IF ( westCommMode.EQ.COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1
430 IF ( eastCommMode.EQ.COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1
431 IF ( westCommMode.EQ.COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1
432 IF ( eastCommMode.EQ.COMM_GET ) westRecvAck(eBl,biE,bjE) = 1
433 ENDDO
434 ENDDO
435
436 C-- Make sure "ack" setting is seen system-wide.
437 C Here strong-ordering is not an issue but we want to make
438 C sure that processes that might spin on the above Ack settings
439 C will see the setting.
440 C ** NOTE ** On some machines we wont spin on the Ack setting
441 C ( particularly the T90 ), instead we will use s system barrier.
442 C On the T90 the system barrier is very fast and switches out the
443 C thread while it waits. On most machines the system barrier
444 C is much too slow and if we own the machine and have one thread
445 C per process preemption is not a problem.
446 IF ( exchNeedsMemSync ) CALL MEMSYNC
447
448 _BARRIER
449 IF ( doingSingleThreadedComms ) THEN
450 C Restore saved settings that were stored to allow
451 C single thred comms.
452 _BEGIN_MASTER(myThid)
453 DO I=1,nThreads
454 myBxLo(I) = myBxLoSave(I)
455 myBxHi(I) = myBxHiSave(I)
456 myByLo(I) = myByLoSave(I)
457 myByHi(I) = myByHiSave(I)
458 ENDDO
459 _END_MASTER(myThid)
460 ENDIF
461 _BARRIER
462
463 RETURN
464 END

  ViewVC Help
Powered by ViewVC 1.1.22