/[MITgcm]/MITgcm/pkg/flt/exch_recv_get_vec.F
ViewVC logotype

Annotation of /MITgcm/pkg/flt/exch_recv_get_vec.F

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


Revision 1.2 - (hide annotations) (download)
Tue Oct 9 00:04:53 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint61f, checkpoint59j, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a
Changes since 1.1: +15 -13 lines
add missing cvs $Header:$ or $Name:$

1 jmc 1.2 C $Header: $
2     C $Name: $
3    
4 adcroft 1.1 #include "CPP_OPTIONS.h"
5     #include "CPP_EEOPTIONS.h"
6    
7     SUBROUTINE EXCH_RL_RECV_GET_VEC_X( arrayE, arrayW,
8     I myd1, myThid )
9     C /==========================================================\
10     C | SUBROUTINE RECV_RL_GET_X |
11     C | o "Send" or "put" X edges for RL array. |
12     C |==========================================================|
13     C | Routine that invokes actual message passing send or |
14     C | direct "put" of data to update X faces of an XY[R] array.|
15     C \==========================================================/
16     IMPLICIT NONE
17    
18     C == Global variables ==
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "EESUPPORT.h"
22     #include "FLT.h"
23     #include "EXCH.h"
24    
25     C == Routine arguments ==
26     C arrayE - Arrays to exchange be exchanged.
27 jmc 1.2 C arrayW
28 adcroft 1.1 C myd1 - sizes.
29     C myd2
30     C theSimulationMode - Forward or reverse mode exchange ( provides
31     C support for adjoint integration of code. )
32     C myThid - Thread number of this instance of S/R EXCH...
33     C eBl - Edge buffer level
34     INTEGER myd1
35     INTEGER myd2
36     _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)
37     INTEGER theSimulationMode
38     INTEGER myThid
39     CEndOfInterface
40    
41     C == Local variables ==
42     C I, J - Loop counters and extents
43     C bi, bj
44     C biW, bjW - West tile indices
45     C biE, bjE - East tile indices
46     C theProc, theTag, theType, - Variables used in message building
47     C theSize
48     C westCommMode - Working variables holding type
49     C eastCommMode of communication a particular
50     C tile face uses.
51     INTEGER I, J
52     INTEGER bi, bj, biW, bjW, biE, bjE
53     INTEGER westCommMode
54     INTEGER eastCommMode
55     INTEGER spinCount
56     #ifdef ALLOW_USE_MPI
57     INTEGER theProc, theTag, theType, theSize
58     INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
59     #endif
60    
61    
62 jmc 1.2 C-- Under a "put" scenario we
63 adcroft 1.1 C-- i. set completetion signal for buffer we put into.
64 jmc 1.2 C-- ii. wait for completetion signal indicating data has been put in
65 adcroft 1.1 C-- our buffer.
66     C-- Under a messaging mode we "receive" the message.
67     C-- Under a "get" scenario we
68     C-- i. Check that the data is ready.
69     C-- ii. Read the data.
70     C-- iii. Set data read flag + memory sync.
71    
72    
73     DO bj=myByLo(myThid),myByHi(myThid)
74     DO bi=myBxLo(myThid),myBxHi(myThid)
75     westCommMode = _tileCommModeW(bi,bj)
76     eastCommMode = _tileCommModeE(bi,bj)
77     biE = _tileBiE(bi,bj)
78     bjE = _tileBjE(bi,bj)
79     biW = _tileBiW(bi,bj)
80     bjW = _tileBjW(bi,bj)
81     IF ( westCommMode .EQ. COMM_MSG ) THEN
82     #ifdef ALLOW_USE_MPI
83     #ifndef ALWAYS_USE_MPI
84     IF ( usingMPI ) THEN
85     #endif
86     theProc = tilePidW(bi,bj)
87     theTag = _tileTagRecvW(bi,bj)
88     theType = MPI_DOUBLE_PRECISION
89     theSize = myd1
90     CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,
91     & theProc, theTag, MPI_COMM_MODEL,
92     & mpiStatus, mpiRc )
93     c if (theProc .eq. 0 .or. theProc .eq. 2) then
94     c if (arrayW(1,bi,bj) .ne. 0.) then
95     c write(errormessageunit,*) 'qq2y: ',myprocid,
96     c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
97     c else
98     c write(errormessageunit,*) 'qq2n: ',myprocid,
99     c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
100     c endif
101     c endif
102     #ifndef ALWAYS_USE_MPI
103 jmc 1.2 ENDIF
104 adcroft 1.1 #endif
105     #endif /* ALLOW_USE_MPI */
106     ENDIF
107     IF ( eastCommMode .EQ. COMM_MSG ) THEN
108     #ifdef ALLOW_USE_MPI
109     #ifndef ALWAYS_USE_MPI
110     IF ( usingMPI ) THEN
111     #endif
112     theProc = tilePidE(bi,bj)
113     theTag = _tileTagRecvE(bi,bj)
114     theType = MPI_DOUBLE_PRECISION
115     theSize = myd1
116     CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,
117     & theProc, theTag, MPI_COMM_MODEL,
118     & mpiStatus, mpiRc )
119     #ifndef ALWAYS_USE_MPI
120 jmc 1.2 ENDIF
121 adcroft 1.1 #endif
122     #endif /* ALLOW_USE_MPI */
123     ENDIF
124     ENDDO
125     ENDDO
126    
127     C-- Wait for buffers I am going read to be ready.
128     IF ( exchUsesBarrier ) THEN
129     C o On some machines ( T90 ) use system barrier rather than spinning.
130     CALL BARRIER( myThid )
131     ELSE
132     C o Spin waiting for completetion flag. This avoids a global-lock
133     C i.e. we only lock waiting for data that we need.
134     DO bj=myByLo(myThid),myByHi(myThid)
135     DO bi=myBxLo(myThid),myBxHi(myThid)
136     spinCount = 0
137     westCommMode = _tileCommModeW(bi,bj)
138     eastCommMode = _tileCommModeE(bi,bj)
139     10 CONTINUE
140     CALL FOOL_THE_COMPILER
141     spinCount = spinCount+1
142     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
143     C WRITE(0,*) ' eBl = ', ebl
144     C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
145     C ENDIF
146     IF ( westRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
147     IF ( eastRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
148     C Clear outstanding requests
149     westRecvAck(1,bi,bj) = 0.
150     eastRecvAck(1,bi,bj) = 0.
151    
152     c IF ( exchVReqsX(1,bi,bj) .GT. 0 ) THEN
153     IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
154     #ifdef ALLOW_USE_MPI
155     #ifndef ALWAYS_USE_MPI
156     IF ( usingMPI ) THEN
157     #endif
158     c CALL MPI_Waitall( exchVReqsX(1,bi,bj), exchReqVIdX(1,1,bi,bj),
159     CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
160     & mpiStatus, mpiRC )
161     #ifndef ALWAYS_USE_MPI
162 jmc 1.2 ENDIF
163 adcroft 1.1 #endif
164     #endif /* ALLOW_USE_MPI */
165     ENDIF
166     C Clear outstanding requests counter
167     c exchVReqsX(1,bi,bj) = 0
168     exchNReqsX(1,bi,bj) = 0
169     C Update statistics
170     ENDDO
171     ENDDO
172     ENDIF
173    
174     C-- Read from the buffers
175     DO bj=myByLo(myThid),myByHi(myThid)
176     DO bi=myBxLo(myThid),myBxHi(myThid)
177    
178     biE = _tileBiE(bi,bj)
179     bjE = _tileBjE(bi,bj)
180     biW = _tileBiW(bi,bj)
181     bjW = _tileBjW(bi,bj)
182     westCommMode = _tileCommModeW(bi,bj)
183     eastCommMode = _tileCommModeE(bi,bj)
184     IF ( eastCommMode .EQ. COMM_GET ) THEN
185     DO I=1,myd1
186     arrayE(I,bi,bj) = arrayW(I,biE,bjE)
187     ENDDO
188     ENDIF
189     IF ( westCommMode .EQ. COMM_GET ) THEN
190     DO I=1,myd1
191     arrayW(I,bi,bj) = arrayE(I,biW,bjW)
192     ENDDO
193     ENDIF
194    
195     ENDDO
196     ENDDO
197    
198     RETURN
199     END
200    
201    
202     SUBROUTINE EXCH_RL_RECV_GET_VEC_Y( arrayN, arrayS,
203     I myd1, myThid )
204     C /==========================================================\
205     C | SUBROUTINE RECV_RL_GET_Y |
206     C | o "Send" or "put" Y edges for RL array. |
207     C |==========================================================|
208     C | Routine that invokes actual message passing send or |
209     C | direct "put" of data to update Y faces of an XY[R] array.|
210     C \==========================================================/
211     IMPLICIT NONE
212    
213     C == Global variables ==
214     #include "SIZE.h"
215     #include "EEPARAMS.h"
216     #include "EESUPPORT.h"
217     #include "FLT.h"
218     #include "EXCH.h"
219    
220     C == Routine arguments ==
221     C arrayN - Arrays to exchange be exchanged.
222 jmc 1.2 C arrayS
223 adcroft 1.1 C myd1 - sizes.
224     C myd2
225     C theSimulationMode - Forward or reverse mode exchange ( provides
226     C support for adjoint integration of code. )
227     C myThid - Thread number of this instance of S/R EXCH...
228     INTEGER myd1
229     INTEGER myd2
230     _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)
231     INTEGER theSimulationMode
232     INTEGER myThid
233     CEndOfInterface
234    
235     C == Local variables ==
236     C I, J - Loop counters and extents
237     C bi, bj
238     C biS, bjS - South tile indices
239     C biE, bjE - North tile indices
240     C theProc, theTag, theType, - Variables used in message building
241     C theSize
242     C southCommMode - Working variables holding type
243     C northCommMode of communication a particular
244     C tile face uses.
245     INTEGER I, J
246     INTEGER bi, bj, biS, bjS, biN, bjN
247     INTEGER southCommMode
248     INTEGER northCommMode
249     INTEGER spinCount
250     #ifdef ALLOW_USE_MPI
251     INTEGER theProc, theTag, theType, theSize
252     INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
253     #endif
254    
255    
256 jmc 1.2 C-- Under a "put" scenario we
257 adcroft 1.1 C-- i. set completetion signal for buffer we put into.
258 jmc 1.2 C-- ii. wait for completetion signal indicating data has been put in
259 adcroft 1.1 C-- our buffer.
260     C-- Under a messaging mode we "receive" the message.
261     C-- Under a "get" scenario we
262     C-- i. Check that the data is ready.
263     C-- ii. Read the data.
264     C-- iii. Set data read flag + memory sync.
265    
266    
267     DO bj=myByLo(myThid),myByHi(myThid)
268     DO bi=myBxLo(myThid),myBxHi(myThid)
269     southCommMode = _tileCommModeS(bi,bj)
270     northCommMode = _tileCommModeN(bi,bj)
271     biN = _tileBiN(bi,bj)
272     bjN = _tileBjN(bi,bj)
273     biS = _tileBiS(bi,bj)
274     bjS = _tileBjS(bi,bj)
275     IF ( southCommMode .EQ. COMM_MSG ) THEN
276     #ifdef ALLOW_USE_MPI
277     #ifndef ALWAYS_USE_MPI
278     IF ( usingMPI ) THEN
279     #endif
280     theProc = tilePidS(bi,bj)
281     theTag = _tileTagRecvS(bi,bj)
282     theType = MPI_DOUBLE_PRECISION
283     theSize = myd1
284     CALL MPI_Recv( arrayS(1,bi,bj), theSize, theType,
285     & theProc, theTag, MPI_COMM_MODEL,
286     & mpiStatus, mpiRc )
287     #ifndef ALWAYS_USE_MPI
288 jmc 1.2 ENDIF
289 adcroft 1.1 #endif
290     #endif /* ALLOW_USE_MPI */
291     ENDIF
292     IF ( northCommMode .EQ. COMM_MSG ) THEN
293     #ifdef ALLOW_USE_MPI
294     #ifndef ALWAYS_USE_MPI
295     IF ( usingMPI ) THEN
296     #endif
297     theProc = tilePidN(bi,bj)
298     theTag = _tileTagRecvN(bi,bj)
299     theType = MPI_DOUBLE_PRECISION
300     theSize = myd1
301     CALL MPI_Recv( arrayN(1,bi,bj), theSize, theType,
302     & theProc, theTag, MPI_COMM_MODEL,
303     & mpiStatus, mpiRc )
304     #ifndef ALWAYS_USE_MPI
305 jmc 1.2 ENDIF
306 adcroft 1.1 #endif
307     #endif /* ALLOW_USE_MPI */
308     ENDIF
309     ENDDO
310     ENDDO
311    
312     C-- Wait for buffers I am going read to be ready.
313     IF ( exchUsesBarrier ) THEN
314     C o On some machines ( T90 ) use system barrier rather than spinning.
315     CALL BARRIER( myThid )
316     ELSE
317     C o Spin waiting for completetion flag. This avoids a global-lock
318     C i.e. we only lock waiting for data that we need.
319     DO bj=myByLo(myThid),myByHi(myThid)
320     DO bi=myBxLo(myThid),myBxHi(myThid)
321     spinCount = 0
322     southCommMode = _tileCommModeS(bi,bj)
323     northCommMode = _tileCommModeN(bi,bj)
324     10 CONTINUE
325     CALL FOOL_THE_COMPILER
326     spinCount = spinCount+1
327     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
328     C WRITE(0,*) ' eBl = ', ebl
329     C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
330     C ENDIF
331     IF ( southRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
332     IF ( northRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
333     C Clear outstanding requests
334     southRecvAck(1,bi,bj) = 0.
335     northRecvAck(1,bi,bj) = 0.
336    
337     c IF ( exchVReqsY(1,bi,bj) .GT. 0 ) THEN
338     IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
339     #ifdef ALLOW_USE_MPI
340     #ifndef ALWAYS_USE_MPI
341     IF ( usingMPI ) THEN
342     #endif
343     c CALL MPI_Waitall( exchVReqsY(1,bi,bj), exchReqVIdY(1,1,bi,bj),
344     CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
345     & mpiStatus, mpiRC )
346     #ifndef ALWAYS_USE_MPI
347 jmc 1.2 ENDIF
348 adcroft 1.1 #endif
349     #endif /* ALLOW_USE_MPI */
350     ENDIF
351     C Clear outstanding requests counter
352     c exchVReqsY(1,bi,bj) = 0
353     exchNReqsY(1,bi,bj) = 0
354     C Update statistics
355     ENDDO
356     ENDDO
357     ENDIF
358    
359     C-- Read from the buffers
360     DO bj=myByLo(myThid),myByHi(myThid)
361     DO bi=myBxLo(myThid),myBxHi(myThid)
362    
363     biN = _tileBiN(bi,bj)
364     bjN = _tileBjN(bi,bj)
365     biS = _tileBiS(bi,bj)
366     bjS = _tileBjS(bi,bj)
367     southCommMode = _tileCommModeS(bi,bj)
368     northCommMode = _tileCommModeN(bi,bj)
369     IF ( southCommMode .EQ. COMM_GET ) THEN
370     DO I=1,myd1
371     arrayN(I,bi,bj) = arrayS(I,biN,bjN)
372     ENDDO
373     ENDIF
374     IF ( southCommMode .EQ. COMM_GET ) THEN
375     DO I=1,myd1
376     arrayS(I,bi,bj) = arrayN(I,biS,bjS)
377     ENDDO
378     ENDIF
379    
380     ENDDO
381     ENDDO
382    
383     RETURN
384     END
385    

  ViewVC Help
Powered by ViewVC 1.1.22