1 |
C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/exch_recv_get_x.F,v 1.3 1999/03/22 17:37:42 adcroft Exp $ |
2 |
#include "CPP_EEOPTIONS.h" |
3 |
|
4 |
SUBROUTINE EXCH_RL_RECV_GET_X( array, |
5 |
I myOLw, myOLe, myOLs, myOLn, myNz, |
6 |
I exchWidthX, exchWidthY, |
7 |
I theSimulationMode, theCornerMode, myThid ) |
8 |
C /==========================================================\ |
9 |
C | SUBROUTINE RECV_RL_GET_X | |
10 |
C | o "Send" or "put" X edges for RL array. | |
11 |
C |==========================================================| |
12 |
C | Routine that invokes actual message passing send or | |
13 |
C | direct "put" of data to update X faces of an XY[R] array.| |
14 |
C \==========================================================/ |
15 |
IMPLICIT NONE |
16 |
|
17 |
C == Global variables == |
18 |
#include "SIZE.h" |
19 |
#include "EEPARAMS.h" |
20 |
#include "EESUPPORT.h" |
21 |
#include "EXCH.h" |
22 |
|
23 |
C == Routine arguments == |
24 |
C array - Array with edges to exchange. |
25 |
C myOLw - West, East, North and South overlap region sizes. |
26 |
C myOLe |
27 |
C myOLn |
28 |
C myOLs |
29 |
C exchWidthX - Width of data region exchanged. |
30 |
C exchWidthY |
31 |
C theSimulationMode - Forward or reverse mode exchange ( provides |
32 |
C support for adjoint integration of code. ) |
33 |
C theCornerMode - Flag indicating whether corner updates are |
34 |
C needed. |
35 |
C myThid - Thread number of this instance of S/R EXCH... |
36 |
C eBl - Edge buffer level |
37 |
INTEGER myOLw |
38 |
INTEGER myOLe |
39 |
INTEGER myOLs |
40 |
INTEGER myOLn |
41 |
INTEGER myNz |
42 |
_RL array(1-myOLw:sNx+myOLe, |
43 |
& 1-myOLs:sNy+myOLn, |
44 |
& myNZ, nSx, nSy) |
45 |
INTEGER exchWidthX |
46 |
INTEGER exchWidthY |
47 |
INTEGER theSimulationMode |
48 |
INTEGER theCornerMode |
49 |
INTEGER myThid |
50 |
CEndOfInterface |
51 |
|
52 |
C == Local variables == |
53 |
C I, J, K, iMin, iMax, iB - Loop counters and extents |
54 |
C bi, bj |
55 |
C biW, bjW - West tile indices |
56 |
C biE, bjE - East tile indices |
57 |
C eBl - Current exchange buffer level |
58 |
C theProc, theTag, theType, - Variables used in message building |
59 |
C theSize |
60 |
C westCommMode - Working variables holding type |
61 |
C eastCommMode of communication a particular |
62 |
C tile face uses. |
63 |
INTEGER I, J, K, iMin, iMax, iB, iB0 |
64 |
INTEGER bi, bj, biW, bjW, biE, bjE |
65 |
INTEGER eBl |
66 |
INTEGER westCommMode |
67 |
INTEGER eastCommMode |
68 |
INTEGER spinCount |
69 |
#ifdef ALLOW_USE_MPI |
70 |
INTEGER theProc, theTag, theType, theSize |
71 |
INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc |
72 |
#endif |
73 |
|
74 |
|
75 |
C-- Under a "put" scenario we |
76 |
C-- i. set completetion signal for buffer we put into. |
77 |
C-- ii. wait for completetion signal indicating data has been put in |
78 |
C-- our buffer. |
79 |
C-- Under a messaging mode we "receive" the message. |
80 |
C-- Under a "get" scenario we |
81 |
C-- i. Check that the data is ready. |
82 |
C-- ii. Read the data. |
83 |
C-- iii. Set data read flag + memory sync. |
84 |
|
85 |
|
86 |
DO bj=myByLo(myThid),myByHi(myThid) |
87 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
88 |
ebL = exchangeBufLevel(1,bi,bj) |
89 |
westCommMode = _tileCommModeW(bi,bj) |
90 |
eastCommMode = _tileCommModeE(bi,bj) |
91 |
biE = _tileBiE(bi,bj) |
92 |
bjE = _tileBjE(bi,bj) |
93 |
biW = _tileBiW(bi,bj) |
94 |
bjW = _tileBjW(bi,bj) |
95 |
IF ( westCommMode .EQ. COMM_MSG ) THEN |
96 |
#ifdef ALLOW_USE_MPI |
97 |
#ifndef ALWAYS_USE_MPI |
98 |
IF ( usingMPI ) THEN |
99 |
#endif |
100 |
theProc = tilePidW(bi,bj) |
101 |
theTag = _tileTagRecvW(bi,bj) |
102 |
theType = MPI_DOUBLE_PRECISION |
103 |
theSize = sNy*exchWidthX*myNz |
104 |
CALL MPI_Recv( westRecvBuf_RL(1,eBl,bi,bj), theSize, theType, |
105 |
& theProc, theTag, MPI_COMM_MODEL, |
106 |
& mpiStatus, mpiRc ) |
107 |
#ifndef ALWAYS_USE_MPI |
108 |
ENDIF |
109 |
#endif |
110 |
#endif /* ALLOW_USE_MPI */ |
111 |
ENDIF |
112 |
IF ( eastCommMode .EQ. COMM_MSG ) THEN |
113 |
#ifdef ALLOW_USE_MPI |
114 |
#ifndef ALWAYS_USE_MPI |
115 |
IF ( usingMPI ) THEN |
116 |
#endif |
117 |
theProc = tilePidE(bi,bj) |
118 |
theTag = _tileTagRecvE(bi,bj) |
119 |
theType = MPI_DOUBLE_PRECISION |
120 |
theSize = sNy*exchWidthX*myNz |
121 |
CALL MPI_Recv( eastRecvBuf_RL(1,eBl,bi,bj), theSize, theType, |
122 |
& theProc, theTag, MPI_COMM_MODEL, |
123 |
& mpiStatus, mpiRc ) |
124 |
#ifndef ALWAYS_USE_MPI |
125 |
ENDIF |
126 |
#endif |
127 |
#endif /* ALLOW_USE_MPI */ |
128 |
ENDIF |
129 |
ENDDO |
130 |
ENDDO |
131 |
|
132 |
C-- Wait for buffers I am going read to be ready. |
133 |
IF ( exchUsesBarrier ) THEN |
134 |
C o On some machines ( T90 ) use system barrier rather than spinning. |
135 |
CALL BARRIER( myThid ) |
136 |
ELSE |
137 |
C o Spin waiting for completetion flag. This avoids a global-lock |
138 |
C i.e. we only lock waiting for data that we need. |
139 |
DO bj=myByLo(myThid),myByHi(myThid) |
140 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
141 |
spinCount = 0 |
142 |
ebL = exchangeBufLevel(1,bi,bj) |
143 |
westCommMode = _tileCommModeW(bi,bj) |
144 |
eastCommMode = _tileCommModeE(bi,bj) |
145 |
10 CONTINUE |
146 |
CALL FOOL_THE_COMPILER |
147 |
spinCount = spinCount+1 |
148 |
C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN |
149 |
C WRITE(0,*) ' eBl = ', ebl |
150 |
C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT' |
151 |
C ENDIF |
152 |
IF ( westRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10 |
153 |
IF ( eastRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10 |
154 |
C Clear outstanding requests |
155 |
westRecvAck(eBl,bi,bj) = 0. |
156 |
eastRecvAck(eBl,bi,bj) = 0. |
157 |
|
158 |
IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN |
159 |
#ifdef ALLOW_USE_MPI |
160 |
#ifndef ALWAYS_USE_MPI |
161 |
IF ( usingMPI ) THEN |
162 |
#endif |
163 |
CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj), |
164 |
& mpiStatus, mpiRC ) |
165 |
#ifndef ALWAYS_USE_MPI |
166 |
ENDIF |
167 |
#endif |
168 |
#endif /* ALLOW_USE_MPI */ |
169 |
ENDIF |
170 |
C Clear outstanding requests counter |
171 |
exchNReqsX(1,bi,bj) = 0 |
172 |
C Update statistics |
173 |
IF ( exchCollectStatistics ) THEN |
174 |
exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1 |
175 |
exchRecvXSpinCount(1,bi,bj) = |
176 |
& exchRecvXSpinCount(1,bi,bj)+spinCount |
177 |
exchRecvXSpinMax(1,bi,bj) = |
178 |
& MAX(exchRecvXSpinMax(1,bi,bj),spinCount) |
179 |
exchRecvXSpinMin(1,bi,bj) = |
180 |
& MIN(exchRecvXSpinMin(1,bi,bj),spinCount) |
181 |
ENDIF |
182 |
ENDDO |
183 |
ENDDO |
184 |
ENDIF |
185 |
|
186 |
C-- Read from the buffers |
187 |
DO bj=myByLo(myThid),myByHi(myThid) |
188 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
189 |
|
190 |
ebL = exchangeBufLevel(1,bi,bj) |
191 |
biE = _tileBiE(bi,bj) |
192 |
bjE = _tileBjE(bi,bj) |
193 |
biW = _tileBiW(bi,bj) |
194 |
bjW = _tileBjW(bi,bj) |
195 |
westCommMode = _tileCommModeW(bi,bj) |
196 |
eastCommMode = _tileCommModeE(bi,bj) |
197 |
IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN |
198 |
iMin = sNx+1 |
199 |
iMax = sNx+exchWidthX |
200 |
iB0 = 0 |
201 |
IF ( eastCommMode .EQ. COMM_PUT |
202 |
& .OR. eastCommMode .EQ. COMM_MSG ) THEN |
203 |
iB = 0 |
204 |
DO K=1,myNz |
205 |
DO J=1,sNy |
206 |
DO I=iMin,iMax |
207 |
iB = iB + 1 |
208 |
array(I,J,K,bi,bj) = eastRecvBuf_RL(iB,eBl,bi,bj) |
209 |
ENDDO |
210 |
ENDDO |
211 |
ENDDO |
212 |
ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN |
213 |
DO K=1,myNz |
214 |
DO J=1,sNy |
215 |
iB = iB0 |
216 |
DO I=iMin,iMax |
217 |
iB = iB+1 |
218 |
array(I,J,K,bi,bj) = array(iB,J,K,biE,bjE) |
219 |
ENDDO |
220 |
ENDDO |
221 |
ENDDO |
222 |
ENDIF |
223 |
ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN |
224 |
iMin = sNx-exchWidthX+1 |
225 |
iMax = sNx |
226 |
iB0 = 1-exchWidthX-1 |
227 |
IF ( eastCommMode .EQ. COMM_PUT |
228 |
& .OR. eastCommMode .EQ. COMM_MSG ) THEN |
229 |
iB = 0 |
230 |
DO K=1,myNz |
231 |
DO J=1,sNy |
232 |
DO I=iMin,iMax |
233 |
iB = iB + 1 |
234 |
array(I,J,K,bi,bj) = |
235 |
& array(I,J,K,bi,bj)+eastRecvBuf_RL(iB,eBl,bi,bj) |
236 |
ENDDO |
237 |
ENDDO |
238 |
ENDDO |
239 |
ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN |
240 |
DO K=1,myNz |
241 |
DO J=1,sNy |
242 |
iB = iB0 |
243 |
DO I=iMin,iMax |
244 |
iB = iB+1 |
245 |
array(I,J,K,bi,bj) = |
246 |
& array(I,J,K,bi,bj)+array(iB,J,K,biE,bjE) |
247 |
ENDDO |
248 |
ENDDO |
249 |
ENDDO |
250 |
ENDIF |
251 |
ENDIF |
252 |
IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN |
253 |
iMin = 1-exchWidthX |
254 |
iMax = 0 |
255 |
iB0 = sNx-exchWidthX |
256 |
IF ( westCommMode .EQ. COMM_PUT |
257 |
& .OR. westCommMode .EQ. COMM_MSG ) THEN |
258 |
iB = 0 |
259 |
DO K=1,myNz |
260 |
DO J=1,sNy |
261 |
DO I=iMin,iMax |
262 |
iB = iB + 1 |
263 |
array(I,J,K,bi,bj) = westRecvBuf_RL(iB,eBl,bi,bj) |
264 |
ENDDO |
265 |
ENDDO |
266 |
ENDDO |
267 |
ELSEIF ( westCommMode .EQ. COMM_GET ) THEN |
268 |
DO K=1,myNz |
269 |
DO J=1,sNy |
270 |
iB = iB0 |
271 |
DO I=iMin,iMax |
272 |
iB = iB+1 |
273 |
array(I,J,K,bi,bj) = array(iB,J,K,biW,bjW) |
274 |
ENDDO |
275 |
ENDDO |
276 |
ENDDO |
277 |
ENDIF |
278 |
ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN |
279 |
iMin = 1 |
280 |
iMax = 1+exchWidthX-1 |
281 |
iB0 = sNx |
282 |
IF ( westCommMode .EQ. COMM_PUT |
283 |
& .OR. westCommMode .EQ. COMM_MSG ) THEN |
284 |
iB = 0 |
285 |
DO K=1,myNz |
286 |
DO J=1,sNy |
287 |
DO I=iMin,iMax |
288 |
iB = iB + 1 |
289 |
array(I,J,K,bi,bj) = |
290 |
& array(I,J,K,bi,bj)+westRecvBuf_RL(iB,eBl,bi,bj) |
291 |
ENDDO |
292 |
ENDDO |
293 |
ENDDO |
294 |
ELSEIF ( westCommMode .EQ. COMM_GET ) THEN |
295 |
DO K=1,myNz |
296 |
DO J=1,sNy |
297 |
iB = iB0 |
298 |
DO I=iMin,iMax |
299 |
iB = iB+1 |
300 |
array(I,J,K,bi,bj) = |
301 |
& array(I,J,K,bi,bj)+array(iB,J,K,biW,bjW) |
302 |
ENDDO |
303 |
ENDDO |
304 |
ENDDO |
305 |
ENDIF |
306 |
ENDIF |
307 |
|
308 |
ENDDO |
309 |
ENDDO |
310 |
|
311 |
RETURN |
312 |
END |
313 |
|
314 |
|
315 |
SUBROUTINE EXCH_RS_RECV_GET_X( array, |
316 |
I myOLw, myOLe, myOLs, myOLn, myNz, |
317 |
I exchWidthX, exchWidthY, |
318 |
I theSimulationMode, theCornerMode, myThid ) |
319 |
C /==========================================================\ |
320 |
C | SUBROUTINE RECV_GET_X | |
321 |
C | o "Send" or "put" X edges for RS array. | |
322 |
C |==========================================================| |
323 |
C | Routine that invokes actual message passing send or | |
324 |
C | direct "put" of data to update X faces of an XY[R] array.| |
325 |
C \==========================================================/ |
326 |
IMPLICIT NONE |
327 |
|
328 |
C == Global variables == |
329 |
#include "SIZE.h" |
330 |
#include "EEPARAMS.h" |
331 |
#include "EESUPPORT.h" |
332 |
#include "EXCH.h" |
333 |
|
334 |
C == Routine arguments == |
335 |
C array - Array with edges to exchange. |
336 |
C myOLw - West, East, North and South overlap region sizes. |
337 |
C myOLe |
338 |
C myOLn |
339 |
C myOLs |
340 |
C exchWidthX - Width of data region exchanged. |
341 |
C exchWidthY |
342 |
C theSimulationMode - Forward or reverse mode exchange ( provides |
343 |
C support for adjoint integration of code. ) |
344 |
C theCornerMode - Flag indicating whether corner updates are |
345 |
C needed. |
346 |
C myThid - Thread number of this instance of S/R EXCH... |
347 |
C eBl - Edge buffer level |
348 |
INTEGER myOLw |
349 |
INTEGER myOLe |
350 |
INTEGER myOLs |
351 |
INTEGER myOLn |
352 |
INTEGER myNz |
353 |
_RS array(1-myOLw:sNx+myOLe, |
354 |
& 1-myOLs:sNy+myOLn, |
355 |
& myNZ, nSx, nSy) |
356 |
INTEGER exchWidthX |
357 |
INTEGER exchWidthY |
358 |
INTEGER theSimulationMode |
359 |
INTEGER theCornerMode |
360 |
INTEGER myThid |
361 |
CEndOfInterface |
362 |
|
363 |
C == Local variables == |
364 |
C I, J, K, iMin, iMax, iB - Loop counters and extents |
365 |
C bi, bj |
366 |
C biW, bjW - West tile indices |
367 |
C biE, bjE - East tile indices |
368 |
C eBl - Current exchange buffer level |
369 |
C theProc, theTag, theType, - Variables used in message building |
370 |
C theSize |
371 |
C westCommMode - Working variables holding type |
372 |
C eastCommMode of communication a particular |
373 |
C tile face uses. |
374 |
INTEGER I, J, K, iMin, iMax, iB, iB0 |
375 |
INTEGER bi, bj, biW, bjW, biE, bjE |
376 |
INTEGER eBl |
377 |
INTEGER westCommMode |
378 |
INTEGER eastCommMode |
379 |
INTEGER spinCount |
380 |
#ifdef ALLOW_USE_MPI |
381 |
INTEGER theProc, theTag, theType, theSize |
382 |
INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc |
383 |
#endif |
384 |
|
385 |
|
386 |
C-- Under a "put" scenario we |
387 |
C-- i. set completetion signal for buffer we put into. |
388 |
C-- ii. wait for completetion signal indicating data has been put in |
389 |
C-- our buffer. |
390 |
C-- Under a messaging mode we "receive" the message. |
391 |
C-- Under a "get" scenario we |
392 |
C-- i. Check that the data is ready. |
393 |
C-- ii. Read the data. |
394 |
C-- iii. Set data read flag + memory sync. |
395 |
|
396 |
|
397 |
DO bj=myByLo(myThid),myByHi(myThid) |
398 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
399 |
ebL = exchangeBufLevel(1,bi,bj) |
400 |
westCommMode = _tileCommModeW(bi,bj) |
401 |
eastCommMode = _tileCommModeE(bi,bj) |
402 |
biE = _tileBiE(bi,bj) |
403 |
bjE = _tileBjE(bi,bj) |
404 |
biW = _tileBiW(bi,bj) |
405 |
bjW = _tileBjW(bi,bj) |
406 |
IF ( westCommMode .EQ. COMM_MSG ) THEN |
407 |
#ifdef ALLOW_USE_MPI |
408 |
#ifndef ALWAYS_USE_MPI |
409 |
IF ( usingMPI ) THEN |
410 |
#endif |
411 |
theProc = tilePidW(bi,bj) |
412 |
theTag = _tileTagRecvW(bi,bj) |
413 |
theType = MPI_DOUBLE_PRECISION |
414 |
#ifdef RS_IS_REAL4 |
415 |
theType = MPI_REAL4 |
416 |
#endif |
417 |
theSize = sNy*exchWidthX*myNz |
418 |
CALL MPI_Recv( westRecvBuf_RS(1,eBl,bi,bj), theSize, theType, |
419 |
& theProc, theTag, MPI_COMM_MODEL, |
420 |
& mpiStatus, mpiRc ) |
421 |
#ifndef ALWAYS_USE_MPI |
422 |
ENDIF |
423 |
#endif |
424 |
#endif /* ALLOW_USE_MPI */ |
425 |
ENDIF |
426 |
IF ( eastCommMode .EQ. COMM_MSG ) THEN |
427 |
#ifdef ALLOW_USE_MPI |
428 |
#ifndef ALWAYS_USE_MPI |
429 |
IF ( usingMPI ) THEN |
430 |
#endif |
431 |
theProc = tilePidE(bi,bj) |
432 |
theTag = _tileTagRecvE(bi,bj) |
433 |
theType = MPI_DOUBLE_PRECISION |
434 |
#ifdef RS_IS_REAL4 |
435 |
theType = MPI_REAL4 |
436 |
#endif |
437 |
theSize = sNy*exchWidthX*myNz |
438 |
CALL MPI_Recv( eastRecvBuf_RS(1,eBl,bi,bj), theSize, theType, |
439 |
& theProc, theTag, MPI_COMM_MODEL, |
440 |
& mpiStatus, mpiRc ) |
441 |
#ifndef ALWAYS_USE_MPI |
442 |
ENDIF |
443 |
#endif |
444 |
#endif /* ALLOW_USE_MPI */ |
445 |
ENDIF |
446 |
ENDDO |
447 |
ENDDO |
448 |
|
449 |
C-- Wait for buffers I am going read to be ready. |
450 |
IF ( exchUsesBarrier ) THEN |
451 |
C o On some machines ( T90 ) use system barrier rather than spinning. |
452 |
CALL BARRIER( myThid ) |
453 |
ELSE |
454 |
C o Spin waiting for completetion flag. This avoids a global-lock |
455 |
C i.e. we only lock waiting for data that we need. |
456 |
DO bj=myByLo(myThid),myByHi(myThid) |
457 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
458 |
spinCount = 0 |
459 |
ebL = exchangeBufLevel(1,bi,bj) |
460 |
westCommMode = _tileCommModeW(bi,bj) |
461 |
eastCommMode = _tileCommModeE(bi,bj) |
462 |
10 CONTINUE |
463 |
CALL FOOL_THE_COMPILER |
464 |
spinCount = spinCount+1 |
465 |
C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN |
466 |
C WRITE(0,*) ' eBl = ', ebl |
467 |
C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT' |
468 |
C ENDIF |
469 |
IF ( westRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10 |
470 |
IF ( eastRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10 |
471 |
C Clear outstanding requests |
472 |
westRecvAck(eBl,bi,bj) = 0. |
473 |
eastRecvAck(eBl,bi,bj) = 0. |
474 |
|
475 |
IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN |
476 |
#ifdef ALLOW_USE_MPI |
477 |
#ifndef ALWAYS_USE_MPI |
478 |
IF ( usingMPI ) THEN |
479 |
#endif |
480 |
CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj), |
481 |
& mpiStatus, mpiRC ) |
482 |
#ifndef ALWAYS_USE_MPI |
483 |
ENDIF |
484 |
#endif |
485 |
#endif /* ALLOW_USE_MPI */ |
486 |
ENDIF |
487 |
C Clear outstanding requests counter |
488 |
exchNReqsX(1,bi,bj) = 0 |
489 |
C Update statistics |
490 |
IF ( exchCollectStatistics ) THEN |
491 |
exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1 |
492 |
exchRecvXSpinCount(1,bi,bj) = |
493 |
& exchRecvXSpinCount(1,bi,bj)+spinCount |
494 |
exchRecvXSpinMax(1,bi,bj) = |
495 |
& MAX(exchRecvXSpinMax(1,bi,bj),spinCount) |
496 |
exchRecvXSpinMin(1,bi,bj) = |
497 |
& MIN(exchRecvXSpinMin(1,bi,bj),spinCount) |
498 |
ENDIF |
499 |
ENDDO |
500 |
ENDDO |
501 |
ENDIF |
502 |
|
503 |
C-- Read from the buffers |
504 |
DO bj=myByLo(myThid),myByHi(myThid) |
505 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
506 |
|
507 |
ebL = exchangeBufLevel(1,bi,bj) |
508 |
biE = _tileBiE(bi,bj) |
509 |
bjE = _tileBjE(bi,bj) |
510 |
biW = _tileBiW(bi,bj) |
511 |
bjW = _tileBjW(bi,bj) |
512 |
westCommMode = _tileCommModeW(bi,bj) |
513 |
eastCommMode = _tileCommModeE(bi,bj) |
514 |
IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN |
515 |
iMin = sNx+1 |
516 |
iMax = sNx+exchWidthX |
517 |
iB0 = 0 |
518 |
ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN |
519 |
iMin = sNx-exchWidthX+1 |
520 |
iMax = sNx |
521 |
iB0 = 1-exchWidthX-1 |
522 |
ENDIF |
523 |
IF ( eastCommMode .EQ. COMM_PUT |
524 |
& .OR. eastCommMode .EQ. COMM_MSG ) THEN |
525 |
iB = 0 |
526 |
DO K=1,myNz |
527 |
DO J=1,sNy |
528 |
DO I=iMin,iMax |
529 |
iB = iB + 1 |
530 |
array(I,J,K,bi,bj) = eastRecvBuf_RS(iB,eBl,bi,bj) |
531 |
ENDDO |
532 |
ENDDO |
533 |
ENDDO |
534 |
ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN |
535 |
DO K=1,myNz |
536 |
DO J=1,sNy |
537 |
iB = iB0 |
538 |
DO I=iMin,iMax |
539 |
iB = iB+1 |
540 |
array(I,J,K,bi,bj) = array(iB,J,K,biE,bjE) |
541 |
ENDDO |
542 |
ENDDO |
543 |
ENDDO |
544 |
ENDIF |
545 |
IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN |
546 |
iMin = 1-exchWidthX |
547 |
iMax = 0 |
548 |
iB0 = sNx-exchWidthX |
549 |
ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN |
550 |
iMin = 1 |
551 |
iMax = 1+exchWidthX-1 |
552 |
iB0 = sNx |
553 |
ENDIF |
554 |
IF ( westCommMode .EQ. COMM_PUT |
555 |
& .OR. westCommMode .EQ. COMM_MSG ) THEN |
556 |
iB = 0 |
557 |
DO K=1,myNz |
558 |
DO J=1,sNy |
559 |
DO I=iMin,iMax |
560 |
iB = iB + 1 |
561 |
array(I,J,K,bi,bj) = westRecvBuf_RS(iB,eBl,bi,bj) |
562 |
ENDDO |
563 |
ENDDO |
564 |
ENDDO |
565 |
ELSEIF ( westCommMode .EQ. COMM_GET ) THEN |
566 |
DO K=1,myNz |
567 |
DO J=1,sNy |
568 |
iB = iB0 |
569 |
DO I=iMin,iMax |
570 |
iB = iB+1 |
571 |
array(I,J,K,bi,bj) = array(iB,J,K,biW,bjW) |
572 |
ENDDO |
573 |
ENDDO |
574 |
ENDDO |
575 |
ENDIF |
576 |
|
577 |
ENDDO |
578 |
ENDDO |
579 |
|
580 |
RETURN |
581 |
END |
582 |
|