/[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.15 - (hide annotations) (download)
Mon Sep 3 19:37:54 2012 UTC (11 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63s, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.14: +7 -7 lines
avoid unused variable (+ start to remove ALWAYS_USE_MPI)

1 jmc 1.15 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_y.template,v 1.14 2010/05/17 02:28:06 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 jmc 1.15 INTEGER theProc, theTag, theType, theSize
85 adcroft 1.1 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
86 jmc 1.15 # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
87     INTEGER pReqI
88     # endif
89     #endif /* ALLOW_USE_MPI */
90 cnh 1.2 CEOP
91 adcroft 1.1
92 jmc 1.14 C-- Under a "put" scenario we
93 adcroft 1.1 C-- i. set completetion signal for buffer we put into.
94 jmc 1.14 C-- ii. wait for completetion signal indicating data has been put in
95 adcroft 1.1 C-- our buffer.
96     C-- Under a messaging mode we "receive" the message.
97     C-- Under a "get" scenario we
98     C-- i. Check that the data is ready.
99     C-- ii. Read the data.
100     C-- iii. Set data read flag + memory sync.
101    
102     #ifdef ALLOW_USE_MPI
103 jmc 1.14 IF ( usingMPI ) THEN
104 jmc 1.15
105 jmc 1.14 C-- Receive buffer data: Only Master Thread do proc communication
106     _BEGIN_MASTER(myThid)
107    
108     DO bj=1,nSy
109     DO bi=1,nSx
110     eBl = exchangeBufLevel(1,bi,bj)
111     southCommMode = _tileCommModeS(bi,bj)
112     northCommMode = _tileCommModeN(bi,bj)
113     biN = _tileBiN(bi,bj)
114     bjN = _tileBjN(bi,bj)
115     biS = _tileBiS(bi,bj)
116     bjS = _tileBjS(bi,bj)
117     theType = _MPI_TYPE_RX
118     theSize = sNx*exchWidthY*myNz
119     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
120     theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
121     ENDIF
122    
123     IF ( southCommMode .EQ. COMM_MSG ) THEN
124 adcroft 1.1 theProc = tilePidS(bi,bj)
125     theTag = _tileTagRecvS(bi,bj)
126 utke 1.12 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
127 jmc 1.14 CALL MPI_Recv( southRecvBuf_RX(1,eBl,bi,bj), theSize,
128     & theType, theProc, theTag, MPI_COMM_MODEL,
129 adcroft 1.1 & mpiStatus, mpiRc )
130 jmc 1.14 # else
131 utke 1.11 pReqI=exchNReqsY(1,bi,bj)+1
132 jmc 1.14 CALL ampi_recv_RX(
133     & southRecvBuf_RX(1,eBl,bi,bj) ,
134     & theSize ,
135     & theType ,
136     & theProc ,
137     & theTag ,
138     & MPI_COMM_MODEL ,
139     & exchReqIdY(pReqI,1,bi,bj),
140     & exchNReqsY(1,bi,bj),
141     & mpiStatus ,
142     & mpiRc )
143 utke 1.12 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
144 jmc 1.14 southRecvAck(eBl,bi,bj) = 1
145 adcroft 1.1 ENDIF
146 jmc 1.14
147 adcroft 1.1 IF ( northCommMode .EQ. COMM_MSG ) THEN
148     theProc = tilePidN(bi,bj)
149     theTag = _tileTagRecvN(bi,bj)
150 utke 1.12 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
151 jmc 1.14 CALL MPI_Recv( northRecvBuf_RX(1,eBl,bi,bj), theSize,
152     & theType, theProc, theTag, MPI_COMM_MODEL,
153 adcroft 1.1 & mpiStatus, mpiRc )
154 utke 1.9 # else
155 jmc 1.13 pReqI=exchNReqsY(1,bi,bj)+1
156 jmc 1.14 CALL ampi_recv_RX(
157     & northRecvBuf_RX(1,eBl,bi,bj) ,
158     & theSize ,
159     & theType ,
160     & theProc ,
161     & theTag ,
162     & MPI_COMM_MODEL ,
163     & exchReqIdY(pReqI,1,bi,bj),
164     & exchNReqsY(1,bi,bj),
165     & mpiStatus ,
166     & mpiRc )
167     # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
168     northRecvAck(eBl,bi,bj) = 1
169     ENDIF
170     ENDDO
171     ENDDO
172    
173     C-- Processes wait for buffers I am going to read to be ready.
174     IF ( .NOT.exchUsesBarrier ) THEN
175     DO bj=1,nSy
176     DO bi=1,nSx
177     IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
178     # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
179     CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
180     & mpiStatus, mpiRC )
181     # else
182     CALL ampi_waitall(
183     & exchNReqsY(1,bi,bj),
184     & exchReqIdY(1,1,bi,bj),
185     & mpiStatus,
186     & mpiRC )
187 utke 1.12 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
188 jmc 1.14 ENDIF
189     C Clear outstanding requests counter
190     exchNReqsY(1,bi,bj) = 0
191     ENDDO
192     ENDDO
193     ENDIF
194    
195     _END_MASTER(myThid)
196     C-- need to sync threads after master has received data ;
197     C (done after mpi waitall in case waitall is really needed)
198     _BARRIER
199    
200     ENDIF
201 adcroft 1.1 #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