/[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.14 - (hide annotations) (download)
Mon May 17 02:28:06 2010 UTC (14 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62g, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint63, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c
Changes since 1.13: +163 -208 lines
 - Separate buffer filling and MPI sending: allow EXCH-1 to work for local
   array (non-shared) when using MPI+MTH. Also reduces number of BARRIER
   (even without using MPI).
 - Message mode: move RecvAck setting (indicator of buffer being ready)
   from send_put to recv_get S/R (was useless before, but not sure if
   it's much more useful now);
 - switch the order of sync: MPI-proc 1rst and then threads;
 - take out spin-waiting code (#undef EXCH_USE_SPINNING), use BARRIER instead.

1 jmc 1.14 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_y.template,v 1.13 2009/01/09 22:51:12 jmc Exp $
2 cnh 1.2 C $Name: $
3 adcroft 1.1 #include "CPP_EEOPTIONS.h"
4 jmc 1.14 #undef EXCH_USE_SPINNING
5 adcroft 1.1
6 cnh 1.2 CBOP
7     C !ROUTINE: EXCH_RX_RECV_GET_Y
8    
9     C !INTERFACE:
10 adcroft 1.1 SUBROUTINE EXCH_RX_RECV_GET_Y( array,
11     I myOLw, myOLe, myOLs, myOLn, myNz,
12     I exchWidthX, exchWidthY,
13     I theSimulationMode, theCornerMode, myThid )
14     IMPLICIT NONE
15    
16 cnh 1.2 C !DESCRIPTION:
17     C *==========================================================*
18 jmc 1.14 C | SUBROUTINE RECV_GET_Y
19     C | o "Send" or "put" Y edges for RX array.
20 cnh 1.2 C *==========================================================*
21 jmc 1.14 C | Routine that invokes actual message passing send or
22     C | direct "put" of data to update X faces of an XY[R] array.
23 cnh 1.2 C *==========================================================*
24    
25     C !USES:
26 adcroft 1.1 C == Global variables ==
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29     #include "EESUPPORT.h"
30     #include "EXCH.h"
31    
32 cnh 1.2 C !INPUT/OUTPUT PARAMETERS:
33 adcroft 1.1 C == Routine arguments ==
34 cnh 1.2 C array :: Array with edges to exchange.
35     C myOLw :: West, East, North and South overlap region sizes.
36 adcroft 1.1 C myOLe
37     C myOLn
38     C myOLs
39 cnh 1.2 C exchWidthX :: Width of data region exchanged.
40 adcroft 1.1 C exchWidthY
41 cnh 1.2 C theSimulationMode :: Forward or reverse mode exchange ( provides
42     C support for adjoint integration of code. )
43     C theCornerMode :: Flag indicating whether corner updates are
44     C needed.
45     C myThid :: Thread number of this instance of S/R EXCH...
46     C eBl :: Edge buffer level
47 adcroft 1.1 INTEGER myOLw
48     INTEGER myOLe
49     INTEGER myOLs
50     INTEGER myOLn
51     INTEGER myNz
52     _RX array(1-myOLw:sNx+myOLe,
53     & 1-myOLs:sNy+myOLn,
54     & myNZ, nSx, nSy)
55     INTEGER exchWidthX
56     INTEGER exchWidthY
57     INTEGER theSimulationMode
58     INTEGER theCornerMode
59     INTEGER myThid
60    
61 cnh 1.2 C !LOCAL VARIABLES:
62 adcroft 1.1 C == Local variables ==
63 jmc 1.14 C i, j, k, iMin, iMax, iB :: Loop counters and extents
64 adcroft 1.1 C bi, bj
65 cnh 1.2 C biS, bjS :: South tile indices
66     C biN, bjN :: North tile indices
67     C eBl :: Current exchange buffer level
68     C theProc, theTag, theType, :: Variables used in message building
69 adcroft 1.1 C theSize
70 cnh 1.2 C southCommMode :: Working variables holding type
71     C northCommMode of communication a particular
72     C tile face uses.
73     C spinCount :: Exchange statistics counter
74     C mpiStatus :: MPI error code
75 jmc 1.14 INTEGER i, j, k, iMin, iMax, jMin, jMax, iB, iB0
76 adcroft 1.1 INTEGER bi, bj, biS, bjS, biN, bjN
77     INTEGER eBl
78     INTEGER southCommMode
79     INTEGER northCommMode
80 jmc 1.14 #ifdef EXCH_USE_SPINNING
81 adcroft 1.1 INTEGER spinCount
82 jmc 1.14 #endif
83 adcroft 1.1 #ifdef ALLOW_USE_MPI
84 utke 1.11 INTEGER theProc, theTag, theType, theSize, pReqI
85 adcroft 1.1 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
86     #endif
87 cnh 1.2 CEOP
88 adcroft 1.1
89 jmc 1.14 C-- Under a "put" scenario we
90 adcroft 1.1 C-- i. set completetion signal for buffer we put into.
91 jmc 1.14 C-- ii. wait for completetion signal indicating data has been put in
92 adcroft 1.1 C-- our buffer.
93     C-- Under a messaging mode we "receive" the message.
94     C-- Under a "get" scenario we
95     C-- i. Check that the data is ready.
96     C-- ii. Read the data.
97     C-- iii. Set data read flag + memory sync.
98    
99     #ifdef ALLOW_USE_MPI
100     #ifndef ALWAYS_USE_MPI
101 jmc 1.14 IF ( usingMPI ) THEN
102 adcroft 1.1 #endif
103 jmc 1.14 C-- Receive buffer data: Only Master Thread do proc communication
104     _BEGIN_MASTER(myThid)
105    
106     DO bj=1,nSy
107     DO bi=1,nSx
108     eBl = exchangeBufLevel(1,bi,bj)
109     southCommMode = _tileCommModeS(bi,bj)
110     northCommMode = _tileCommModeN(bi,bj)
111     biN = _tileBiN(bi,bj)
112     bjN = _tileBjN(bi,bj)
113     biS = _tileBiS(bi,bj)
114     bjS = _tileBjS(bi,bj)
115     theType = _MPI_TYPE_RX
116     theSize = sNx*exchWidthY*myNz
117     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
118     theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
119     ENDIF
120    
121     IF ( southCommMode .EQ. COMM_MSG ) THEN
122 adcroft 1.1 theProc = tilePidS(bi,bj)
123     theTag = _tileTagRecvS(bi,bj)
124 utke 1.12 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
125 jmc 1.14 CALL MPI_Recv( southRecvBuf_RX(1,eBl,bi,bj), theSize,
126     & theType, theProc, theTag, MPI_COMM_MODEL,
127 adcroft 1.1 & mpiStatus, mpiRc )
128 jmc 1.14 # else
129 utke 1.11 pReqI=exchNReqsY(1,bi,bj)+1
130 jmc 1.14 CALL ampi_recv_RX(
131     & southRecvBuf_RX(1,eBl,bi,bj) ,
132     & theSize ,
133     & theType ,
134     & theProc ,
135     & theTag ,
136     & MPI_COMM_MODEL ,
137     & exchReqIdY(pReqI,1,bi,bj),
138     & exchNReqsY(1,bi,bj),
139     & mpiStatus ,
140     & mpiRc )
141 utke 1.12 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
142 jmc 1.14 southRecvAck(eBl,bi,bj) = 1
143 adcroft 1.1 ENDIF
144 jmc 1.14
145 adcroft 1.1 IF ( northCommMode .EQ. COMM_MSG ) THEN
146     theProc = tilePidN(bi,bj)
147     theTag = _tileTagRecvN(bi,bj)
148 utke 1.12 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
149 jmc 1.14 CALL MPI_Recv( northRecvBuf_RX(1,eBl,bi,bj), theSize,
150     & theType, theProc, theTag, MPI_COMM_MODEL,
151 adcroft 1.1 & mpiStatus, mpiRc )
152 utke 1.9 # else
153 jmc 1.13 pReqI=exchNReqsY(1,bi,bj)+1
154 jmc 1.14 CALL ampi_recv_RX(
155     & northRecvBuf_RX(1,eBl,bi,bj) ,
156     & theSize ,
157     & theType ,
158     & theProc ,
159     & theTag ,
160     & MPI_COMM_MODEL ,
161     & exchReqIdY(pReqI,1,bi,bj),
162     & exchNReqsY(1,bi,bj),
163     & mpiStatus ,
164     & mpiRc )
165     # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
166     northRecvAck(eBl,bi,bj) = 1
167     ENDIF
168     ENDDO
169     ENDDO
170    
171     C-- Processes wait for buffers I am going to read to be ready.
172     IF ( .NOT.exchUsesBarrier ) THEN
173     DO bj=1,nSy
174     DO bi=1,nSx
175     IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
176     # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
177     CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
178     & mpiStatus, mpiRC )
179     # else
180     CALL ampi_waitall(
181     & exchNReqsY(1,bi,bj),
182     & exchReqIdY(1,1,bi,bj),
183     & mpiStatus,
184     & mpiRC )
185 utke 1.12 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
186 jmc 1.14 ENDIF
187     C Clear outstanding requests counter
188     exchNReqsY(1,bi,bj) = 0
189     ENDDO
190     ENDDO
191     ENDIF
192    
193     _END_MASTER(myThid)
194     C-- need to sync threads after master has received data ;
195     C (done after mpi waitall in case waitall is really needed)
196     _BARRIER
197    
198 adcroft 1.1 #ifndef ALWAYS_USE_MPI
199 jmc 1.14 ENDIF
200 adcroft 1.1 #endif
201     #endif /* ALLOW_USE_MPI */
202    
203 jmc 1.14 C-- Threads wait for buffers I am going to read to be ready.
204     C note: added BARRIER in exch_send_put S/R and here above (message mode)
205     C so that we no longer needs this (undef EXCH_USE_SPINNING)
206     #ifdef EXCH_USE_SPINNING
207 adcroft 1.1 IF ( exchUsesBarrier ) THEN
208     C o On some machines ( T90 ) use system barrier rather than spinning.
209     CALL BARRIER( myThid )
210     ELSE
211     C o Spin waiting for completetion flag. This avoids a global-lock
212     C i.e. we only lock waiting for data that we need.
213     DO bj=myByLo(myThid),myByHi(myThid)
214     DO bi=myBxLo(myThid),myBxHi(myThid)
215 jmc 1.14
216     spinCount = 0
217     eBl = exchangeBufLevel(1,bi,bj)
218 adcroft 1.1 southCommMode = _tileCommModeS(bi,bj)
219     northCommMode = _tileCommModeN(bi,bj)
220 utke 1.12 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
221 adcroft 1.1 10 CONTINUE
222 jmc 1.4 CALL FOOL_THE_COMPILER( spinCount )
223 adcroft 1.1 spinCount = spinCount+1
224     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
225     C STOP ' S/R EXCH_RECV_GET_Y: spinCount .GT. _EXCH_SPIN_LIMIT'
226     C ENDIF
227 jmc 1.8 IF ( southRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
228     IF ( northRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
229 utke 1.9 # else
230 jmc 1.14 DO WHILE ((southRecvAck(eBl,bi,bj) .EQ. 0
231     & .OR.
232     & northRecvAck(eBl,bi,bj) .EQ. 0 ))
233 utke 1.9 CALL FOOL_THE_COMPILER( spinCount )
234     spinCount = spinCount+1
235 jmc 1.14 ENDDO
236 utke 1.12 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
237 adcroft 1.1 C Clear requests
238 jmc 1.8 southRecvAck(eBl,bi,bj) = 0
239     northRecvAck(eBl,bi,bj) = 0
240 adcroft 1.1 C Update statistics
241     IF ( exchCollectStatistics ) THEN
242     exchRecvYExchCount(1,bi,bj) = exchRecvYExchCount(1,bi,bj)+1
243 jmc 1.14 exchRecvYSpinCount(1,bi,bj) =
244 adcroft 1.1 & exchRecvYSpinCount(1,bi,bj)+spinCount
245 jmc 1.14 exchRecvYSpinMax(1,bi,bj) =
246 adcroft 1.1 & MAX(exchRecvYSpinMax(1,bi,bj),spinCount)
247 jmc 1.14 exchRecvYSpinMin(1,bi,bj) =
248 adcroft 1.1 & MIN(exchRecvYSpinMin(1,bi,bj),spinCount)
249     ENDIF
250    
251     ENDDO
252     ENDDO
253     ENDIF
254 jmc 1.14 #endif /* EXCH_USE_SPINNING */
255    
256     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
257 adcroft 1.1
258     C-- Read from the buffers
259     DO bj=myByLo(myThid),myByHi(myThid)
260     DO bi=myBxLo(myThid),myBxHi(myThid)
261    
262 jmc 1.14 eBl = exchangeBufLevel(1,bi,bj)
263     biN = _tileBiN(bi,bj)
264     bjN = _tileBjN(bi,bj)
265     biS = _tileBiS(bi,bj)
266     bjS = _tileBjS(bi,bj)
267 adcroft 1.1 southCommMode = _tileCommModeS(bi,bj)
268     northCommMode = _tileCommModeN(bi,bj)
269     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
270     iMin = 1-exchWidthX
271     iMax = sNx+exchWidthX
272     ELSE
273     iMin = 1
274     iMax = sNx
275     ENDIF
276     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
277     jMin = sNy+1
278     jMax = sNy+exchWidthY
279     iB0 = 0
280 jmc 1.14 IF ( northCommMode .EQ. COMM_PUT
281     & .OR. northCommMode .EQ. COMM_MSG ) THEN
282 adcroft 1.1 iB = 0
283 jmc 1.14 DO k=1,myNz
284     DO j=jMin,jMax
285     DO i=iMin,iMax
286 adcroft 1.1 iB = iB + 1
287 jmc 1.14 array(i,j,k,bi,bj) = northRecvBuf_RX(iB,eBl,bi,bj)
288 adcroft 1.1 ENDDO
289     ENDDO
290     ENDDO
291     ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
292 jmc 1.14 DO k=1,myNz
293 adcroft 1.1 iB = iB0
294 jmc 1.14 DO j=jMin,jMax
295 adcroft 1.1 iB = iB+1
296 jmc 1.14 DO i=iMin,iMax
297     array(i,j,k,bi,bj) = array(i,iB,k,biN,bjN)
298 adcroft 1.1 ENDDO
299     ENDDO
300     ENDDO
301     ENDIF
302     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
303     jMin = sNy-exchWidthY+1
304     jMax = sNy
305     iB0 = 1-exchWidthY-1
306 jmc 1.14 IF ( northCommMode .EQ. COMM_PUT
307     & .OR. northCommMode .EQ. COMM_MSG ) THEN
308 adcroft 1.1 iB = 0
309 jmc 1.14 DO k=1,myNz
310     DO j=jMin,jMax
311     DO i=iMin,iMax
312 adcroft 1.1 iB = iB + 1
313 jmc 1.14 array(i,j,k,bi,bj) =
314     & array(i,j,k,bi,bj) + northRecvBuf_RX(iB,eBl,bi,bj)
315 adcroft 1.1 ENDDO
316     ENDDO
317     ENDDO
318     ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
319 jmc 1.14 DO k=1,myNz
320 adcroft 1.1 iB = iB0
321 jmc 1.14 DO j=jMin,jMax
322 adcroft 1.1 iB = iB+1
323 jmc 1.14 DO i=iMin,iMax
324     array(i,j,k,bi,bj) =
325     & array(i,j,k,bi,bj) + array(i,iB,k,biN,bjN)
326     array(i,iB,k,biN,bjN) = 0.0
327 adcroft 1.1 ENDDO
328     ENDDO
329     ENDDO
330     ENDIF
331     ENDIF
332    
333     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
334     jMin = 1-exchWidthY
335     jMax = 0
336     iB0 = sNy-exchWidthY
337 jmc 1.14 IF ( southCommMode .EQ. COMM_PUT
338     & .OR. southCommMode .EQ. COMM_MSG ) THEN
339 adcroft 1.1 iB = 0
340 jmc 1.14 DO k=1,myNz
341     DO j=jMin,jMax
342     DO i=iMin,iMax
343 adcroft 1.1 iB = iB + 1
344 jmc 1.14 array(i,j,k,bi,bj) = southRecvBuf_RX(iB,eBl,bi,bj)
345 adcroft 1.1 ENDDO
346     ENDDO
347     ENDDO
348     ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
349 jmc 1.14 DO k=1,myNz
350 adcroft 1.1 iB = iB0
351 jmc 1.14 DO j=jMin,jMax
352 adcroft 1.1 iB = iB+1
353 jmc 1.14 DO i=iMin,iMax
354     array(i,j,k,bi,bj) = array(i,iB,k,biS,bjS)
355 adcroft 1.1 ENDDO
356     ENDDO
357     ENDDO
358     ENDIF
359     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
360     jMin = 1
361     jMax = 1+exchWidthY-1
362     iB0 = sNy
363 jmc 1.14 IF ( southCommMode .EQ. COMM_PUT
364     & .OR. southCommMode .EQ. COMM_MSG ) THEN
365 adcroft 1.1 iB = 0
366 jmc 1.14 DO k=1,myNz
367     DO j=jMin,jMax
368     DO i=iMin,iMax
369 adcroft 1.1 iB = iB + 1
370 jmc 1.14 array(i,j,k,bi,bj) =
371     & array(i,j,k,bi,bj) + southRecvBuf_RX(iB,eBl,bi,bj)
372 adcroft 1.1 ENDDO
373     ENDDO
374     ENDDO
375     ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
376 jmc 1.14 DO k=1,myNz
377 adcroft 1.1 iB = iB0
378 jmc 1.14 DO j=jMin,jMax
379 adcroft 1.1 iB = iB+1
380 jmc 1.14 DO i=iMin,iMax
381     array(i,j,k,bi,bj) =
382     & array(i,j,k,bi,bj) + array(i,iB,k,biS,bjS)
383     array(i,iB,k,biS,bjS) = 0.0
384 adcroft 1.1 ENDDO
385     ENDDO
386     ENDDO
387     ENDIF
388     ENDIF
389 jmc 1.14
390 adcroft 1.1 ENDDO
391     ENDDO
392    
393     RETURN
394     END

  ViewVC Help
Powered by ViewVC 1.1.22