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

Annotation 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 - (hide 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 utke 1.9 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 cnh 1.2 C $Name: $
3 adcroft 1.1 #include "CPP_EEOPTIONS.h"
4    
5 cnh 1.2 CBOP
6    
7     C !ROUTINE: EXCH_RX_SEND_PUT_X
8    
9     C !INTERFACE:
10 adcroft 1.1 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 cnh 1.2 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 adcroft 1.1
24 cnh 1.2 C !USES:
25 adcroft 1.1 C == Global variables ==
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "EESUPPORT.h"
29     #include "EXCH.h"
30 cnh 1.2
31     C !INPUT/OUTPUT PARAMETERS:
32 adcroft 1.1 C == Routine arguments ==
33 cnh 1.2 C array :: Array with edges to exchange.
34     C myOLw :: West, East, North and South overlap region sizes.
35 adcroft 1.1 C myOLe
36     C myOLn
37     C myOLs
38 cnh 1.2 C exchWidthX :: Width of data region exchanged.
39 adcroft 1.1 C exchWidthY
40 cnh 1.2 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 adcroft 1.1 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 cnh 1.2 C !LOCAL VARIABLES:
61 adcroft 1.1 C == Local variables ==
62 cnh 1.2 C I, J, K, iMin, iMax, iB :: Loop counters and extents
63 adcroft 1.1 C bi, bj
64 cnh 1.2 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 adcroft 1.1 C theSize
69 cnh 1.2 C westCommMode :: Working variables holding type
70     C eastCommMode of communication a particular
71     C tile face uses.
72 adcroft 1.1 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 utke 1.8 # ifdef ALLOW_AUTODIFF_OPENAD
81     INTEGER mpiStatus(MPI_STATUS_SIZE)
82     # endif
83 adcroft 1.1 #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 cnh 1.2 CEOP
108    
109 cnh 1.4 INTEGER myBxLoSave(MAX_NO_THREADS)
110     INTEGER myBxHiSave(MAX_NO_THREADS)
111     INTEGER myByLoSave(MAX_NO_THREADS)
112     INTEGER myByHiSave(MAX_NO_THREADS)
113 cnh 1.5 LOGICAL doingSingleThreadedComms
114 cnh 1.4
115 cnh 1.5 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 cnh 1.4 ENDIF
150 cnh 1.5 #endif
151     #endif
152 cnh 1.4
153 utke 1.8 #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 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
211 utke 1.9 # ifndef ALLOW_AUTODIFF_OPENAD
212 adcroft 1.1 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 utke 1.8 # 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 utke 1.9 & exchReqIdX(exchNReqsX(1,bi,bj)+1,1,bi,bj),
225     & exchNReqsX(1,bi,bj),
226     & mpiStatus ,
227 utke 1.8 & mpiRc )
228     # endif /* ALLOW_AUTODIFF_OPENAD */
229 adcroft 1.1 #ifndef ALWAYS_USE_MPI
230     ENDIF
231     #endif
232     #endif /* ALLOW_USE_MPI */
233 jmc 1.7 eastRecvAck(eBl,biW,bjW) = 1
234 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
271 utke 1.9 # ifndef ALLOW_AUTODIFF_OPENAD
272 adcroft 1.1 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 utke 1.8 # 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 utke 1.9 & exchReqIdX(exchNReqsX(1,bi,bj)+1,1,bi,bj) ,
285     & exchNReqsX(1,bi,bj),
286     & mpiStatus ,
287 utke 1.8 & mpiRc )
288     # endif /* ALLOW_AUTODIFF_OPENAD */
289 adcroft 1.1 #ifndef ALWAYS_USE_MPI
290     ENDIF
291     #endif
292     #endif /* ALLOW_USE_MPI */
293 jmc 1.7 westRecvAck(eBl,biE,bjE) = 1
294 adcroft 1.1 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 utke 1.8 #ifndef ALLOW_AUTODIFF_OPENAD
309    
310 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
336 adcroft 1.1 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 jmc 1.7 eastRecvAck(eBl,biW,bjW) = 1
345 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
384 adcroft 1.1 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 jmc 1.7 westRecvAck(eBl,biE,bjE) = 1
393 adcroft 1.1 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 utke 1.8 #endif /* ALLOW_AUTODIFF_OPENAD */
410 adcroft 1.1 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 jmc 1.7 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 adcroft 1.1 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 cnh 1.6 _BARRIER
453 cnh 1.5 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 cnh 1.6 _BARRIER
466 cnh 1.4
467 adcroft 1.1 RETURN
468     END

  ViewVC Help
Powered by ViewVC 1.1.22