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

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

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


Revision 1.7 - (hide annotations) (download)
Fri Nov 11 03:01:26 2005 UTC (18 years, 7 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint58b_post, checkpoint57y_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint58w_post, checkpoint57y_pre, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58r_post, checkpoint58n_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.6: +3 -3 lines
Ooops - _BARRIER in wrong place wrt to local logical.

1 cnh 1.7 C $Header: /u/u0/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_x.template,v 1.6 2005/11/09 17:22:08 cnh 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_X
7    
8     C !INTERFACE:
9 adcroft 1.1 SUBROUTINE EXCH_RX_RECV_GET_X( 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_RX_GET_X
18     C | o "Send" or "put" X 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 adcroft 1.1 C support for adjoint integration of code. )
42 cnh 1.2 C theCornerMode :: Flag indicating whether corner updates are
43 adcroft 1.1 C needed.
44 cnh 1.2 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 biW, bjW :: West tile indices
65     C biE, bjE :: East 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 westCommMode :: Working variables holding type
70     C eastCommMode of communication a particular
71     C tile face uses.
72 adcroft 1.1 INTEGER I, J, K, iMin, iMax, iB, iB0
73     INTEGER bi, bj, biW, bjW, biE, bjE
74     INTEGER eBl
75     INTEGER westCommMode
76     INTEGER eastCommMode
77     INTEGER spinCount
78     #ifdef ALLOW_USE_MPI
79     INTEGER theProc, theTag, theType, theSize
80     INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
81     #endif
82 cnh 1.2 CEOP
83 adcroft 1.1
84 cnh 1.5 INTEGER myBxLoSave(MAX_NO_THREADS)
85     INTEGER myBxHiSave(MAX_NO_THREADS)
86     INTEGER myByLoSave(MAX_NO_THREADS)
87     INTEGER myByHiSave(MAX_NO_THREADS)
88 cnh 1.6 LOGICAL doingSingleThreadedComms
89 cnh 1.5
90 cnh 1.6 doingSingleThreadedComms = .FALSE.
91     #ifdef ALLOW_USE_MPI
92     #ifndef ALWAYS_USE_MPI
93     IF ( usingMPI ) THEN
94     #endif
95     C Set default behavior to have MPI comms done by a single thread.
96     C Most MPI implementations don't support concurrent comms from
97     C several threads.
98     IF ( nThreads .GT. 1 ) THEN
99     _BARRIER
100     _BEGIN_MASTER( myThid )
101     DO I=1,nThreads
102     myBxLoSave(I) = myBxLo(I)
103     myBxHiSave(I) = myBxHi(I)
104     myByLoSave(I) = myByLo(I)
105     myByHiSave(I) = myByHi(I)
106     ENDDO
107     C Comment out loop below and myB[xy][Lo|Hi](1) settings below
108     C if you want to get multi-threaded MPI comms.
109     DO I=1,nThreads
110     myBxLo(I) = 0
111     myBxHi(I) = -1
112     myByLo(I) = 0
113     myByHi(I) = -1
114     ENDDO
115     myBxLo(1) = 1
116     myBxHi(1) = nSx
117     myByLo(1) = 1
118     myByHi(1) = nSy
119     doingSingleThreadedComms = .TRUE.
120     _END_MASTER( myThid )
121     _BARRIER
122     ENDIF
123     #ifndef ALWAYS_USE_MPI
124 cnh 1.5 ENDIF
125 cnh 1.6 #endif
126     #endif
127 adcroft 1.1
128     C-- Under a "put" scenario we
129     C-- i. set completetion signal for buffer we put into.
130     C-- ii. wait for completetion signal indicating data has been put in
131     C-- our buffer.
132     C-- Under a messaging mode we "receive" the message.
133     C-- Under a "get" scenario we
134     C-- i. Check that the data is ready.
135     C-- ii. Read the data.
136     C-- iii. Set data read flag + memory sync.
137    
138    
139     DO bj=myByLo(myThid),myByHi(myThid)
140     DO bi=myBxLo(myThid),myBxHi(myThid)
141     ebL = exchangeBufLevel(1,bi,bj)
142     westCommMode = _tileCommModeW(bi,bj)
143     eastCommMode = _tileCommModeE(bi,bj)
144     biE = _tileBiE(bi,bj)
145     bjE = _tileBjE(bi,bj)
146     biW = _tileBiW(bi,bj)
147     bjW = _tileBjW(bi,bj)
148     IF ( westCommMode .EQ. COMM_MSG ) THEN
149     #ifdef ALLOW_USE_MPI
150     #ifndef ALWAYS_USE_MPI
151     IF ( usingMPI ) THEN
152     #endif
153     theProc = tilePidW(bi,bj)
154     theTag = _tileTagRecvW(bi,bj)
155 dimitri 1.3 theType = _MPI_TYPE_RX
156 adcroft 1.1 theSize = sNy*exchWidthX*myNz
157     CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
158     & theProc, theTag, MPI_COMM_MODEL,
159     & mpiStatus, mpiRc )
160     #ifndef ALWAYS_USE_MPI
161     ENDIF
162     #endif
163     #endif /* ALLOW_USE_MPI */
164     ENDIF
165     IF ( eastCommMode .EQ. COMM_MSG ) THEN
166     #ifdef ALLOW_USE_MPI
167     #ifndef ALWAYS_USE_MPI
168     IF ( usingMPI ) THEN
169     #endif
170     theProc = tilePidE(bi,bj)
171     theTag = _tileTagRecvE(bi,bj)
172 dimitri 1.3 theType = _MPI_TYPE_RX
173 adcroft 1.1 theSize = sNy*exchWidthX*myNz
174     CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
175     & theProc, theTag, MPI_COMM_MODEL,
176     & mpiStatus, mpiRc )
177     #ifndef ALWAYS_USE_MPI
178     ENDIF
179     #endif
180     #endif /* ALLOW_USE_MPI */
181     ENDIF
182     ENDDO
183     ENDDO
184    
185     C-- Wait for buffers I am going read to be ready.
186     IF ( exchUsesBarrier ) THEN
187     C o On some machines ( T90 ) use system barrier rather than spinning.
188     CALL BARRIER( myThid )
189     ELSE
190     C o Spin waiting for completetion flag. This avoids a global-lock
191     C i.e. we only lock waiting for data that we need.
192     DO bj=myByLo(myThid),myByHi(myThid)
193     DO bi=myBxLo(myThid),myBxHi(myThid)
194     spinCount = 0
195     ebL = exchangeBufLevel(1,bi,bj)
196     westCommMode = _tileCommModeW(bi,bj)
197     eastCommMode = _tileCommModeE(bi,bj)
198     10 CONTINUE
199 jmc 1.4 CALL FOOL_THE_COMPILER( spinCount )
200 adcroft 1.1 spinCount = spinCount+1
201     C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
202     C WRITE(*,*) ' eBl = ', ebl
203     C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
204     C ENDIF
205     IF ( westRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10
206     IF ( eastRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10
207     C Clear outstanding requests
208     westRecvAck(eBl,bi,bj) = 0.
209     eastRecvAck(eBl,bi,bj) = 0.
210    
211     IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
212     #ifdef ALLOW_USE_MPI
213     #ifndef ALWAYS_USE_MPI
214     IF ( usingMPI ) THEN
215     #endif
216     CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
217     & mpiStatus, mpiRC )
218     #ifndef ALWAYS_USE_MPI
219     ENDIF
220     #endif
221     #endif /* ALLOW_USE_MPI */
222     ENDIF
223     C Clear outstanding requests counter
224     exchNReqsX(1,bi,bj) = 0
225     C Update statistics
226     IF ( exchCollectStatistics ) THEN
227     exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
228     exchRecvXSpinCount(1,bi,bj) =
229     & exchRecvXSpinCount(1,bi,bj)+spinCount
230     exchRecvXSpinMax(1,bi,bj) =
231     & MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
232     exchRecvXSpinMin(1,bi,bj) =
233     & MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
234     ENDIF
235     ENDDO
236     ENDDO
237     ENDIF
238    
239     C-- Read from the buffers
240     DO bj=myByLo(myThid),myByHi(myThid)
241     DO bi=myBxLo(myThid),myBxHi(myThid)
242    
243     ebL = exchangeBufLevel(1,bi,bj)
244     biE = _tileBiE(bi,bj)
245     bjE = _tileBjE(bi,bj)
246     biW = _tileBiW(bi,bj)
247     bjW = _tileBjW(bi,bj)
248     westCommMode = _tileCommModeW(bi,bj)
249     eastCommMode = _tileCommModeE(bi,bj)
250     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
251     iMin = sNx+1
252     iMax = sNx+exchWidthX
253     iB0 = 0
254     IF ( eastCommMode .EQ. COMM_PUT
255     & .OR. eastCommMode .EQ. COMM_MSG ) THEN
256     iB = 0
257     DO K=1,myNz
258     DO J=1,sNy
259     DO I=iMin,iMax
260     iB = iB + 1
261     array(I,J,K,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
262     ENDDO
263     ENDDO
264     ENDDO
265     ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
266     DO K=1,myNz
267     DO J=1,sNy
268     iB = iB0
269     DO I=iMin,iMax
270     iB = iB+1
271     array(I,J,K,bi,bj) = array(iB,J,K,biE,bjE)
272     ENDDO
273     ENDDO
274     ENDDO
275     ENDIF
276     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
277     iMin = sNx-exchWidthX+1
278     iMax = sNx
279     iB0 = 1-exchWidthX-1
280     IF ( eastCommMode .EQ. COMM_PUT
281     & .OR. eastCommMode .EQ. COMM_MSG ) THEN
282     iB = 0
283     DO K=1,myNz
284     DO J=1,sNy
285     DO I=iMin,iMax
286     iB = iB + 1
287     array(I,J,K,bi,bj) =
288     & array(I,J,K,bi,bj)+eastRecvBuf_RX(iB,eBl,bi,bj)
289     ENDDO
290     ENDDO
291     ENDDO
292     ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
293     DO K=1,myNz
294     DO J=1,sNy
295     iB = iB0
296     DO I=iMin,iMax
297     iB = iB+1
298     array(I,J,K,bi,bj) =
299     & array(I,J,K,bi,bj)+array(iB,J,K,biE,bjE)
300     ENDDO
301     ENDDO
302     ENDDO
303     ENDIF
304     ENDIF
305     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
306     iMin = 1-exchWidthX
307     iMax = 0
308     iB0 = sNx-exchWidthX
309     IF ( westCommMode .EQ. COMM_PUT
310     & .OR. westCommMode .EQ. COMM_MSG ) THEN
311     iB = 0
312     DO K=1,myNz
313     DO J=1,sNy
314     DO I=iMin,iMax
315     iB = iB + 1
316     array(I,J,K,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
317     ENDDO
318     ENDDO
319     ENDDO
320     ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
321     DO K=1,myNz
322     DO J=1,sNy
323     iB = iB0
324     DO I=iMin,iMax
325     iB = iB+1
326     array(I,J,K,bi,bj) = array(iB,J,K,biW,bjW)
327     ENDDO
328     ENDDO
329     ENDDO
330     ENDIF
331     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
332     iMin = 1
333     iMax = 1+exchWidthX-1
334     iB0 = sNx
335     IF ( westCommMode .EQ. COMM_PUT
336     & .OR. westCommMode .EQ. COMM_MSG ) THEN
337     iB = 0
338     DO K=1,myNz
339     DO J=1,sNy
340     DO I=iMin,iMax
341     iB = iB + 1
342     array(I,J,K,bi,bj) =
343     & array(I,J,K,bi,bj)+westRecvBuf_RX(iB,eBl,bi,bj)
344     ENDDO
345     ENDDO
346     ENDDO
347     ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
348     DO K=1,myNz
349     DO J=1,sNy
350     iB = iB0
351     DO I=iMin,iMax
352     iB = iB+1
353     array(I,J,K,bi,bj) =
354     & array(I,J,K,bi,bj)+array(iB,J,K,biW,bjW)
355     ENDDO
356     ENDDO
357     ENDDO
358     ENDIF
359     ENDIF
360    
361     ENDDO
362     ENDDO
363    
364 cnh 1.7 _BARRIER
365 cnh 1.6 IF ( doingSingleThreadedComms ) THEN
366     C Restore saved settings that were stored to allow
367     C single thred comms.
368     _BEGIN_MASTER(myThid)
369     DO I=1,nThreads
370     myBxLo(I) = myBxLoSave(I)
371     myBxHi(I) = myBxHiSave(I)
372     myByLo(I) = myByLoSave(I)
373     myByHi(I) = myByHiSave(I)
374     ENDDO
375     _END_MASTER(myThid)
376     ENDIF
377 cnh 1.7 _BARRIER
378 cnh 1.5
379 adcroft 1.1 RETURN
380     END

  ViewVC Help
Powered by ViewVC 1.1.22