/[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.11 - (show annotations) (download)
Wed Apr 9 22:33:42 2008 UTC (16 years, 2 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r
Changes since 1.10: +1 -3 lines
need to keep manual adjoint for plain openad runs

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

  ViewVC Help
Powered by ViewVC 1.1.22