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

Contents 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.15 - (show annotations) (download)
Wed May 19 08:14:16 2010 UTC (15 years, 2 months ago) by mlosch
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.14: +1 -2 lines
I can't believe it: I caught Jean-Michel checking in stuff that does
not compile (o:
removed a '#'

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

  ViewVC Help
Powered by ViewVC 1.1.22