/[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.3 - (hide annotations) (download)
Sun Jan 4 00:58:23 2009 UTC (15 years, 5 months ago) by jmc
Branch: MAIN
Changes since 1.2: +10 -10 lines
- clean-up
- fix restart

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/flt/exch_recv_get_vec.F,v 1.2 2007/10/09 00:04:53 jmc Exp $
2 jmc 1.2 C $Name: $
3    
4 adcroft 1.1 #include "CPP_OPTIONS.h"
5 jmc 1.3
6     C-- Contents
7     C-- o EXCH_RL_RECV_GET_VEC_X
8     C-- o EXCH_RL_RECV_GET_VEC_Y
9    
10     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
11 adcroft 1.1
12     SUBROUTINE EXCH_RL_RECV_GET_VEC_X( arrayE, arrayW,
13     I myd1, myThid )
14     C /==========================================================\
15     C | SUBROUTINE RECV_RL_GET_X |
16     C | o "Send" or "put" X edges for RL array. |
17     C |==========================================================|
18     C | Routine that invokes actual message passing send or |
19     C | direct "put" of data to update X faces of an XY[R] array.|
20     C \==========================================================/
21     IMPLICIT NONE
22    
23     C == Global variables ==
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "EESUPPORT.h"
27     #include "FLT.h"
28     #include "EXCH.h"
29    
30     C == Routine arguments ==
31     C arrayE - Arrays to exchange be exchanged.
32 jmc 1.2 C arrayW
33 adcroft 1.1 C myd1 - sizes.
34     C theSimulationMode - Forward or reverse mode exchange ( provides
35     C support for adjoint integration of code. )
36     C myThid - Thread number of this instance of S/R EXCH...
37     C eBl - Edge buffer level
38     INTEGER myd1
39     _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)
40     INTEGER myThid
41     CEndOfInterface
42    
43     C == Local variables ==
44     C I, J - Loop counters and extents
45     C bi, bj
46     C biW, bjW - West tile indices
47     C biE, bjE - East tile indices
48     C theProc, theTag, theType, - Variables used in message building
49     C theSize
50     C westCommMode - Working variables holding type
51     C eastCommMode of communication a particular
52     C tile face uses.
53 jmc 1.3 INTEGER I
54 adcroft 1.1 INTEGER bi, bj, biW, bjW, biE, bjE
55     INTEGER westCommMode
56     INTEGER eastCommMode
57     INTEGER spinCount
58     #ifdef ALLOW_USE_MPI
59     INTEGER theProc, theTag, theType, theSize
60     INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
61     #endif
62    
63    
64 jmc 1.2 C-- Under a "put" scenario we
65 adcroft 1.1 C-- i. set completetion signal for buffer we put into.
66 jmc 1.2 C-- ii. wait for completetion signal indicating data has been put in
67 adcroft 1.1 C-- our buffer.
68     C-- Under a messaging mode we "receive" the message.
69     C-- Under a "get" scenario we
70     C-- i. Check that the data is ready.
71     C-- ii. Read the data.
72     C-- iii. Set data read flag + memory sync.
73    
74    
75     DO bj=myByLo(myThid),myByHi(myThid)
76     DO bi=myBxLo(myThid),myBxHi(myThid)
77     westCommMode = _tileCommModeW(bi,bj)
78     eastCommMode = _tileCommModeE(bi,bj)
79     biE = _tileBiE(bi,bj)
80     bjE = _tileBjE(bi,bj)
81     biW = _tileBiW(bi,bj)
82     bjW = _tileBjW(bi,bj)
83     IF ( westCommMode .EQ. COMM_MSG ) THEN
84     #ifdef ALLOW_USE_MPI
85     #ifndef ALWAYS_USE_MPI
86     IF ( usingMPI ) THEN
87     #endif
88     theProc = tilePidW(bi,bj)
89     theTag = _tileTagRecvW(bi,bj)
90     theType = MPI_DOUBLE_PRECISION
91     theSize = myd1
92     CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,
93     & theProc, theTag, MPI_COMM_MODEL,
94     & mpiStatus, mpiRc )
95     c if (theProc .eq. 0 .or. theProc .eq. 2) then
96     c if (arrayW(1,bi,bj) .ne. 0.) then
97     c write(errormessageunit,*) 'qq2y: ',myprocid,
98     c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
99     c else
100     c write(errormessageunit,*) 'qq2n: ',myprocid,
101     c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
102     c endif
103     c endif
104     #ifndef ALWAYS_USE_MPI
105 jmc 1.2 ENDIF
106 adcroft 1.1 #endif
107     #endif /* ALLOW_USE_MPI */
108     ENDIF
109     IF ( eastCommMode .EQ. COMM_MSG ) THEN
110     #ifdef ALLOW_USE_MPI
111     #ifndef ALWAYS_USE_MPI
112     IF ( usingMPI ) THEN
113     #endif
114     theProc = tilePidE(bi,bj)
115     theTag = _tileTagRecvE(bi,bj)
116     theType = MPI_DOUBLE_PRECISION
117     theSize = myd1
118     CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,
119     & theProc, theTag, MPI_COMM_MODEL,
120     & mpiStatus, mpiRc )
121     #ifndef ALWAYS_USE_MPI
122 jmc 1.2 ENDIF
123 adcroft 1.1 #endif
124     #endif /* ALLOW_USE_MPI */
125     ENDIF
126     ENDDO
127     ENDDO
128    
129     C-- Wait for buffers I am going read to be ready.
130     IF ( exchUsesBarrier ) THEN
131     C o On some machines ( T90 ) use system barrier rather than spinning.
132     CALL BARRIER( myThid )
133     ELSE
134     C o Spin waiting for completetion flag. This avoids a global-lock
135     C i.e. we only lock waiting for data that we need.
136     DO bj=myByLo(myThid),myByHi(myThid)
137     DO bi=myBxLo(myThid),myBxHi(myThid)
138     spinCount = 0
139     westCommMode = _tileCommModeW(bi,bj)
140     eastCommMode = _tileCommModeE(bi,bj)
141     10 CONTINUE
142     CALL FOOL_THE_COMPILER
143     spinCount = spinCount+1
144     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
145     C WRITE(0,*) ' eBl = ', ebl
146     C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
147     C ENDIF
148     IF ( westRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
149     IF ( eastRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
150     C Clear outstanding requests
151     westRecvAck(1,bi,bj) = 0.
152     eastRecvAck(1,bi,bj) = 0.
153    
154     c IF ( exchVReqsX(1,bi,bj) .GT. 0 ) THEN
155     IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
156     #ifdef ALLOW_USE_MPI
157     #ifndef ALWAYS_USE_MPI
158     IF ( usingMPI ) THEN
159     #endif
160     c CALL MPI_Waitall( exchVReqsX(1,bi,bj), exchReqVIdX(1,1,bi,bj),
161     CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
162     & mpiStatus, mpiRC )
163     #ifndef ALWAYS_USE_MPI
164 jmc 1.2 ENDIF
165 adcroft 1.1 #endif
166     #endif /* ALLOW_USE_MPI */
167     ENDIF
168     C Clear outstanding requests counter
169     c exchVReqsX(1,bi,bj) = 0
170     exchNReqsX(1,bi,bj) = 0
171     C Update statistics
172     ENDDO
173     ENDDO
174     ENDIF
175    
176     C-- Read from the buffers
177     DO bj=myByLo(myThid),myByHi(myThid)
178     DO bi=myBxLo(myThid),myBxHi(myThid)
179    
180     biE = _tileBiE(bi,bj)
181     bjE = _tileBjE(bi,bj)
182     biW = _tileBiW(bi,bj)
183     bjW = _tileBjW(bi,bj)
184     westCommMode = _tileCommModeW(bi,bj)
185     eastCommMode = _tileCommModeE(bi,bj)
186     IF ( eastCommMode .EQ. COMM_GET ) THEN
187     DO I=1,myd1
188     arrayE(I,bi,bj) = arrayW(I,biE,bjE)
189     ENDDO
190     ENDIF
191     IF ( westCommMode .EQ. COMM_GET ) THEN
192     DO I=1,myd1
193     arrayW(I,bi,bj) = arrayE(I,biW,bjW)
194     ENDDO
195     ENDIF
196    
197     ENDDO
198     ENDDO
199    
200     RETURN
201     END
202    
203 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
204 adcroft 1.1
205     SUBROUTINE EXCH_RL_RECV_GET_VEC_Y( arrayN, arrayS,
206     I myd1, myThid )
207     C /==========================================================\
208     C | SUBROUTINE RECV_RL_GET_Y |
209     C | o "Send" or "put" Y edges for RL array. |
210     C |==========================================================|
211     C | Routine that invokes actual message passing send or |
212     C | direct "put" of data to update Y faces of an XY[R] array.|
213     C \==========================================================/
214     IMPLICIT NONE
215    
216     C == Global variables ==
217     #include "SIZE.h"
218     #include "EEPARAMS.h"
219     #include "EESUPPORT.h"
220     #include "FLT.h"
221     #include "EXCH.h"
222    
223     C == Routine arguments ==
224     C arrayN - Arrays to exchange be exchanged.
225 jmc 1.2 C arrayS
226 adcroft 1.1 C myd1 - sizes.
227     C theSimulationMode - Forward or reverse mode exchange ( provides
228     C support for adjoint integration of code. )
229     C myThid - Thread number of this instance of S/R EXCH...
230     INTEGER myd1
231     _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)
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 jmc 1.3 INTEGER I
246 adcroft 1.1 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