/[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.8 - (hide 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 utke 1.8 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 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 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
212 utke 1.8 # ifndef ALLOW_AUTODIFF_OPENAD
213 adcroft 1.1 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     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
225     & mpiRc )
226     # endif /* ALLOW_AUTODIFF_OPENAD */
227 adcroft 1.1 #ifndef ALWAYS_USE_MPI
228     ENDIF
229     #endif
230     #endif /* ALLOW_USE_MPI */
231 jmc 1.7 eastRecvAck(eBl,biW,bjW) = 1
232 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
269 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
270 utke 1.8 # ifndef ALLOW_AUTODIFF_OPENAD
271 adcroft 1.1 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 utke 1.8 # 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 adcroft 1.1 #ifndef ALWAYS_USE_MPI
286     ENDIF
287     #endif
288     #endif /* ALLOW_USE_MPI */
289 jmc 1.7 westRecvAck(eBl,biE,bjE) = 1
290 adcroft 1.1 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 utke 1.8 #ifndef ALLOW_AUTODIFF_OPENAD
305    
306 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
332 adcroft 1.1 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 jmc 1.7 eastRecvAck(eBl,biW,bjW) = 1
341 adcroft 1.1 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 dimitri 1.3 theType = _MPI_TYPE_RX
380 adcroft 1.1 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 jmc 1.7 westRecvAck(eBl,biE,bjE) = 1
389 adcroft 1.1 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 utke 1.8 #endif /* ALLOW_AUTODIFF_OPENAD */
406 adcroft 1.1 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 jmc 1.7 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 adcroft 1.1 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 cnh 1.6 _BARRIER
449 cnh 1.5 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 cnh 1.6 _BARRIER
462 cnh 1.4
463 adcroft 1.1 RETURN
464     END

  ViewVC Help
Powered by ViewVC 1.1.22