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

Annotation of /MITgcm/eesupp/src/exch_rx_recv_get_y.template

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


Revision 1.9 - (hide annotations) (download)
Tue Mar 18 21:34:01 2008 UTC (16 years, 3 months ago) by utke
Branch: MAIN
Changes since 1.8: +34 -1 lines
aMPI prototype

1 utke 1.9 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_y.template,v 1.8 2008/02/20 20:18:59 jmc Exp $
2 cnh 1.2 C $Name: $
3 adcroft 1.1 #include "CPP_EEOPTIONS.h"
4    
5 cnh 1.2 CBOP
6     C !ROUTINE: EXCH_RX_RECV_GET_Y
7    
8     C !INTERFACE:
9 adcroft 1.1 SUBROUTINE EXCH_RX_RECV_GET_Y( array,
10     I myOLw, myOLe, myOLs, myOLn, myNz,
11     I exchWidthX, exchWidthY,
12     I theSimulationMode, theCornerMode, myThid )
13     IMPLICIT NONE
14    
15 cnh 1.2 C !DESCRIPTION:
16     C *==========================================================*
17     C | SUBROUTINE RECV_GET_Y
18     C | o "Send" or "put" Y 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 adcroft 1.1 C == Global variables ==
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "EESUPPORT.h"
29     #include "EXCH.h"
30    
31 cnh 1.2 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 biS, bjS :: South tile indices
65     C biN, bjN :: North 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 southCommMode :: Working variables holding type
70     C northCommMode of communication a particular
71     C tile face uses.
72     C spinCount :: Exchange statistics counter
73     C mpiStatus :: MPI error code
74 adcroft 1.1 INTEGER I, J, K, iMin, iMax, jMin, jMax, iB, iB0
75     INTEGER bi, bj, biS, bjS, biN, bjN
76     INTEGER eBl
77     INTEGER southCommMode
78     INTEGER northCommMode
79     INTEGER spinCount
80     #ifdef ALLOW_USE_MPI
81     INTEGER theProc, theTag, theType, theSize
82     INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
83     #endif
84 cnh 1.2 CEOP
85 adcroft 1.1
86 cnh 1.5 INTEGER myBxLoSave(MAX_NO_THREADS)
87     INTEGER myBxHiSave(MAX_NO_THREADS)
88     INTEGER myByLoSave(MAX_NO_THREADS)
89     INTEGER myByHiSave(MAX_NO_THREADS)
90 cnh 1.6 LOGICAL doingSingleThreadedComms
91 cnh 1.5
92 cnh 1.6 doingSingleThreadedComms = .FALSE.
93     #ifdef ALLOW_USE_MPI
94     #ifndef ALWAYS_USE_MPI
95     IF ( usingMPI ) THEN
96     #endif
97     C Set default behavior to have MPI comms done by a single thread.
98     C Most MPI implementations don't support concurrent comms from
99     C several threads.
100     IF ( nThreads .GT. 1 ) THEN
101     _BARRIER
102     _BEGIN_MASTER( myThid )
103     DO I=1,nThreads
104     myBxLoSave(I) = myBxLo(I)
105     myBxHiSave(I) = myBxHi(I)
106     myByLoSave(I) = myByLo(I)
107     myByHiSave(I) = myByHi(I)
108     ENDDO
109     C Comment out loop below and myB[xy][Lo|Hi](1) settings below
110     C if you want to get multi-threaded MPI comms.
111     DO I=1,nThreads
112     myBxLo(I) = 0
113     myBxHi(I) = -1
114     myByLo(I) = 0
115     myByHi(I) = -1
116     ENDDO
117     myBxLo(1) = 1
118     myBxHi(1) = nSx
119     myByLo(1) = 1
120     myByHi(1) = nSy
121     doingSingleThreadedComms = .TRUE.
122     _END_MASTER( myThid )
123     _BARRIER
124     ENDIF
125     #ifndef ALWAYS_USE_MPI
126 cnh 1.5 ENDIF
127 cnh 1.6 #endif
128     #endif
129 adcroft 1.1 C-- Under a "put" scenario we
130     C-- i. set completetion signal for buffer we put into.
131     C-- ii. wait for completetion signal indicating data has been put in
132     C-- our buffer.
133     C-- Under a messaging mode we "receive" the message.
134     C-- Under a "get" scenario we
135     C-- i. Check that the data is ready.
136     C-- ii. Read the data.
137     C-- iii. Set data read flag + memory sync.
138    
139    
140     DO bj=myByLo(myThid),myByHi(myThid)
141     DO bi=myBxLo(myThid),myBxHi(myThid)
142     ebL = exchangeBufLevel(1,bi,bj)
143     southCommMode = _tileCommModeS(bi,bj)
144     northCommMode = _tileCommModeN(bi,bj)
145     biN = _tileBiN(bi,bj)
146     bjN = _tileBjN(bi,bj)
147     biS = _tileBiS(bi,bj)
148     bjS = _tileBjS(bi,bj)
149     IF ( southCommMode .EQ. COMM_MSG ) THEN
150     #ifdef ALLOW_USE_MPI
151     #ifndef ALWAYS_USE_MPI
152     IF ( usingMPI ) THEN
153     #endif
154     theProc = tilePidS(bi,bj)
155     theTag = _tileTagRecvS(bi,bj)
156 dimitri 1.3 theType = _MPI_TYPE_RX
157 adcroft 1.1 theSize = sNx*exchWidthY*myNz
158     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS )
159     & theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
160 utke 1.9 # ifndef ALLOW_AUTODIFF_OPENAD
161 adcroft 1.1 CALL MPI_Recv( southRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
162     & theProc, theTag, MPI_COMM_MODEL,
163     & mpiStatus, mpiRc )
164 utke 1.9 # else
165     CALL ampi_recv_RX(
166     & southRecvBuf_RX(1,eBl,bi,bj) ,
167     & theSize ,
168     & theType ,
169     & theProc ,
170     & theTag ,
171     & MPI_COMM_MODEL ,
172     & mpiStatus ,
173     & mpiRc )
174     # endif /* ALLOW_AUTODIFF_OPENAD */
175 adcroft 1.1 #ifndef ALWAYS_USE_MPI
176     ENDIF
177     #endif
178     #endif /* ALLOW_USE_MPI */
179     ENDIF
180     IF ( northCommMode .EQ. COMM_MSG ) THEN
181     #ifdef ALLOW_USE_MPI
182     #ifndef ALWAYS_USE_MPI
183     IF ( usingMPI ) THEN
184     #endif
185     theProc = tilePidN(bi,bj)
186     theTag = _tileTagRecvN(bi,bj)
187 dimitri 1.3 theType = _MPI_TYPE_RX
188 adcroft 1.1 theSize = sNx*exchWidthY*myNz
189     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS )
190     & theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
191 utke 1.9 # ifndef ALLOW_AUTODIFF_OPENAD
192 adcroft 1.1 CALL MPI_Recv( northRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
193     & theProc, theTag, MPI_COMM_MODEL,
194     & mpiStatus, mpiRc )
195 utke 1.9 # else
196     CALL ampi_recv_RX(
197     & northRecvBuf_RX(1,eBl,bi,bj) ,
198     & theSize ,
199     & theType ,
200     & theProc ,
201     & theTag ,
202     & MPI_COMM_MODEL ,
203     & mpiStatus ,
204     & mpiRc )
205     # endif /* ALLOW_AUTODIFF_OPENAD */
206 adcroft 1.1 #ifndef ALWAYS_USE_MPI
207     ENDIF
208     #endif
209     #endif /* ALLOW_USE_MPI */
210     ENDIF
211     ENDDO
212     ENDDO
213    
214     C-- Wait for buffers I am going read to be ready.
215     IF ( exchUsesBarrier ) THEN
216     C o On some machines ( T90 ) use system barrier rather than spinning.
217     CALL BARRIER( myThid )
218     ELSE
219     C o Spin waiting for completetion flag. This avoids a global-lock
220     C i.e. we only lock waiting for data that we need.
221     DO bj=myByLo(myThid),myByHi(myThid)
222     DO bi=myBxLo(myThid),myBxHi(myThid)
223     ebL = exchangeBufLevel(1,bi,bj)
224     southCommMode = _tileCommModeS(bi,bj)
225     northCommMode = _tileCommModeN(bi,bj)
226     spinCount = 0
227 utke 1.9 # ifndef ALLOW_AUTODIFF_OPENAD
228 adcroft 1.1 10 CONTINUE
229 jmc 1.4 CALL FOOL_THE_COMPILER( spinCount )
230 adcroft 1.1 spinCount = spinCount+1
231     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
232     C STOP ' S/R EXCH_RECV_GET_Y: spinCount .GT. _EXCH_SPIN_LIMIT'
233     C ENDIF
234 jmc 1.8 IF ( southRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
235     IF ( northRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
236 utke 1.9 # else
237     do while ((southRecvAck(eBl,bi,bj) .EQ. 0.
238     & .or.
239     & northRecvAck(eBl,bi,bj) .EQ. 0. ))
240     CALL FOOL_THE_COMPILER( spinCount )
241     spinCount = spinCount+1
242     end do
243     # endif /* ALLOW_AUTODIFF_OPENAD */
244 adcroft 1.1 C Clear requests
245 jmc 1.8 southRecvAck(eBl,bi,bj) = 0
246     northRecvAck(eBl,bi,bj) = 0
247 adcroft 1.1 C Update statistics
248     IF ( exchCollectStatistics ) THEN
249     exchRecvYExchCount(1,bi,bj) = exchRecvYExchCount(1,bi,bj)+1
250     exchRecvYSpinCount(1,bi,bj) =
251     & exchRecvYSpinCount(1,bi,bj)+spinCount
252     exchRecvYSpinMax(1,bi,bj) =
253     & MAX(exchRecvYSpinMax(1,bi,bj),spinCount)
254     exchRecvYSpinMin(1,bi,bj) =
255     & MIN(exchRecvYSpinMin(1,bi,bj),spinCount)
256     ENDIF
257    
258    
259     IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
260     #ifdef ALLOW_USE_MPI
261     #ifndef ALWAYS_USE_MPI
262     IF ( usingMPI ) THEN
263     #endif
264     CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
265     & mpiStatus, mpiRC )
266     #ifndef ALWAYS_USE_MPI
267     ENDIF
268     #endif
269     #endif /* ALLOW_USE_MPI */
270     ENDIF
271     C Clear outstanding requests counter
272     exchNReqsY(1,bi,bj) = 0
273     ENDDO
274     ENDDO
275     ENDIF
276    
277     C-- Read from the buffers
278     DO bj=myByLo(myThid),myByHi(myThid)
279     DO bi=myBxLo(myThid),myBxHi(myThid)
280    
281     ebL = exchangeBufLevel(1,bi,bj)
282     biN = _tileBiN(bi,bj)
283     bjN = _tileBjN(bi,bj)
284     biS = _tileBiS(bi,bj)
285     bjS = _tileBjS(bi,bj)
286     southCommMode = _tileCommModeS(bi,bj)
287     northCommMode = _tileCommModeN(bi,bj)
288     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
289     iMin = 1-exchWidthX
290     iMax = sNx+exchWidthX
291     ELSE
292     iMin = 1
293     iMax = sNx
294     ENDIF
295     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
296     jMin = sNy+1
297     jMax = sNy+exchWidthY
298     iB0 = 0
299     IF ( northCommMode .EQ. COMM_PUT
300     & .OR. northCommMode .EQ. COMM_MSG ) THEN
301     iB = 0
302     DO K=1,myNz
303     DO J=jMin,jMax
304     DO I=iMin,iMax
305     iB = iB + 1
306     array(I,J,K,bi,bj) = northRecvBuf_RX(iB,eBl,bi,bj)
307     ENDDO
308     ENDDO
309     ENDDO
310     ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
311     DO K=1,myNz
312     iB = iB0
313     DO J=jMin,jMax
314     iB = iB+1
315     DO I=iMin,iMax
316     array(I,J,K,bi,bj) = array(I,iB,K,biN,bjN)
317     ENDDO
318     ENDDO
319     ENDDO
320     ENDIF
321     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
322     jMin = sNy-exchWidthY+1
323     jMax = sNy
324     iB0 = 1-exchWidthY-1
325     IF ( northCommMode .EQ. COMM_PUT
326     & .OR. northCommMode .EQ. COMM_MSG ) THEN
327     iB = 0
328     DO K=1,myNz
329     DO J=jMin,jMax
330     DO I=iMin,iMax
331     iB = iB + 1
332     array(I,J,K,bi,bj) =
333     & array(I,J,K,bi,bj)+northRecvBuf_RX(iB,eBl,bi,bj)
334     ENDDO
335     ENDDO
336     ENDDO
337     ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
338     DO K=1,myNz
339     iB = iB0
340     DO J=jMin,jMax
341     iB = iB+1
342     DO I=iMin,iMax
343     array(I,J,K,bi,bj) =
344     & array(I,J,K,bi,bj)+array(I,iB,K,biN,bjN)
345     ENDDO
346     ENDDO
347     ENDDO
348     ENDIF
349     ENDIF
350    
351     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
352     jMin = 1-exchWidthY
353     jMax = 0
354     iB0 = sNy-exchWidthY
355     IF ( southCommMode .EQ. COMM_PUT
356     & .OR. southCommMode .EQ. COMM_MSG ) THEN
357     iB = 0
358     DO K=1,myNz
359     DO J=jMin,jMax
360     DO I=iMin,iMax
361     iB = iB + 1
362     array(I,J,K,bi,bj) = southRecvBuf_RX(iB,eBl,bi,bj)
363     ENDDO
364     ENDDO
365     ENDDO
366     ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
367     DO K=1,myNz
368     iB = iB0
369     DO J=jMin,jMax
370     iB = iB+1
371     DO I=iMin,iMax
372     array(I,J,K,bi,bj) = array(I,iB,K,biS,bjS)
373     ENDDO
374     ENDDO
375     ENDDO
376     ENDIF
377     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
378     jMin = 1
379     jMax = 1+exchWidthY-1
380     iB0 = sNy
381     IF ( southCommMode .EQ. COMM_PUT
382     & .OR. southCommMode .EQ. COMM_MSG ) THEN
383     iB = 0
384     DO K=1,myNz
385     DO J=jMin,jMax
386     DO I=iMin,iMax
387     iB = iB + 1
388     array(I,J,K,bi,bj) =
389     & array(I,J,K,bi,bj)+southRecvBuf_RX(iB,eBl,bi,bj)
390     ENDDO
391     ENDDO
392     ENDDO
393     ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
394     DO K=1,myNz
395     iB = iB0
396     DO J=jMin,jMax
397     iB = iB+1
398     DO I=iMin,iMax
399     array(I,J,K,bi,bj) =
400     & array(I,J,K,bi,bj)+array(I,iB,K,biS,bjS)
401     ENDDO
402     ENDDO
403     ENDDO
404     ENDIF
405     ENDIF
406     ENDDO
407     ENDDO
408    
409 cnh 1.7 _BARRIER
410 cnh 1.6 IF ( doingSingleThreadedComms ) THEN
411     C Restore saved settings that were stored to allow
412     C single thred comms.
413     _BEGIN_MASTER(myThid)
414     DO I=1,nThreads
415     myBxLo(I) = myBxLoSave(I)
416     myBxHi(I) = myBxHiSave(I)
417     myByLo(I) = myByLoSave(I)
418     myByHi(I) = myByHiSave(I)
419     ENDDO
420     _END_MASTER(myThid)
421     ENDIF
422 cnh 1.7 _BARRIER
423 cnh 1.5
424 adcroft 1.1 RETURN
425     END

  ViewVC Help
Powered by ViewVC 1.1.22