1 |
C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/exch_jam.F,v 1.4 2001/02/04 14:38:43 cnh Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "CPP_EEOPTIONS.h" |
5 |
|
6 |
#ifndef JAM_WITH_TWO_PROCS_PER_NODE |
7 |
C Single processor JAM stuff |
8 |
|
9 |
#undef USE_MPI_EXCH |
10 |
#define USE_JAM_EXCH |
11 |
|
12 |
CBOP |
13 |
C !ROUTINE: EXCH_XY_O1_R8_JAM |
14 |
|
15 |
C !INTERFACE: |
16 |
SUBROUTINE EXCH_XY_O1_R8_JAM( arr ) |
17 |
IMPLICIT NONE |
18 |
|
19 |
C !DESCRIPTION: |
20 |
C *======================================================================* |
21 |
C | SUBROUTINE EXCH_XY_O1_R8_JAM |
22 |
C | o Specialiased OL=1, JAM binding exchage routine |
23 |
C *======================================================================* |
24 |
C | Routine for high-speed communication directly over JAM library. |
25 |
C | Communication is coded for decomposition in Y only as well as for |
26 |
C | overlap regions of width one. Operates on 64-bit fields only. |
27 |
C *======================================================================* |
28 |
|
29 |
C !USES: |
30 |
#define _OLx 1 |
31 |
#define _OLy 1 |
32 |
C == Global variables == |
33 |
#include "SIZE.h" |
34 |
#include "EEPARAMS.h" |
35 |
#include "EXCH_JAM.h" |
36 |
#include "MPI_INFO.h" |
37 |
#include "JAM_INFO.h" |
38 |
|
39 |
C !INPUT/OUTPUT PARAMETERS: |
40 |
C == Routine arguments == |
41 |
C arr :: Array to exchange |
42 |
Real*8 arr(1-_OLx:sNx+_OLx,1-_OLy:sNy+_OLy) |
43 |
|
44 |
#ifdef LETS_MAKE_JAM |
45 |
|
46 |
C !LOCAL VARIABLES: |
47 |
C == Local variables == |
48 |
C I,J :: Loop counters |
49 |
C northProc, southProc :: Process id numbers |
50 |
C farProc1, farProc2 |
51 |
C toPid, fromPid |
52 |
C rc :: Return code |
53 |
INTEGER I, J |
54 |
INTEGER northProc, southProc |
55 |
INTEGER farProc1, farProc2 |
56 |
INTEGER toPid, fromPid |
57 |
INTEGER rc |
58 |
|
59 |
#ifdef ALLOW_MPI |
60 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
61 |
#endif |
62 |
CEOP |
63 |
|
64 |
C East-west halo update (without corners) |
65 |
DO J=1,sNy |
66 |
DO I=1,_OLx |
67 |
arr(1-I ,J) = arr(sNx-I+1,J) |
68 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
69 |
ENDDO |
70 |
ENDDO |
71 |
|
72 |
C Phase 1 pairing |
73 |
C | 0 | ---> | 1 | |
74 |
C | 0 | <--- | 1 | |
75 |
|
76 |
C | 2 | ---> | 3 | |
77 |
C | 2 | <--- | 3 | |
78 |
|
79 |
C | 4 | ---> | 5 | |
80 |
C | 4 | <--- | 5 | |
81 |
|
82 |
C etc ... |
83 |
C |
84 |
|
85 |
#ifdef USE_MPI_EXCH |
86 |
C North-south halo update (without corners) |
87 |
C Put my edges into a buffers |
88 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
89 |
DO I=1,sNx |
90 |
exchBuf1(I) = arr(I,sNy) |
91 |
exchBuf2(I) = arr(I,1 ) |
92 |
ENDDO |
93 |
ELSE |
94 |
DO I=1,sNx |
95 |
exchBuf1(I) = arr(I,1 ) |
96 |
exchBuf2(I) = arr(I,sNy) |
97 |
ENDDO |
98 |
ENDIF |
99 |
|
100 |
C Exchange the buffers |
101 |
northProc = mpi_northId |
102 |
southProc = mpi_southId |
103 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
104 |
farProc1 = northProc |
105 |
farProc2 = southProc |
106 |
ELSE |
107 |
farProc1 = southProc |
108 |
farProc2 = northProc |
109 |
ENDIF |
110 |
C Even-odd pairs |
111 |
IF ( farProc1 .NE. myProcId ) THEN |
112 |
CALL MPI_Sendrecv_replace(exchBuf1,sNx,MPI_REAL8, |
113 |
& farProc1,0, |
114 |
& farProc1,MPI_ANY_TAG, |
115 |
& MPI_COMM_WORLD,mpiStatus, |
116 |
& rc) |
117 |
ENDIF |
118 |
C Odd-even pairs |
119 |
IF ( farProc2 .NE. myProcId ) THEN |
120 |
CALL MPI_Sendrecv_replace(exchBuf2,sNx,MPI_REAL8, |
121 |
& farProc2,0, |
122 |
& farProc2,MPI_ANY_TAG, |
123 |
& MPI_COMM_WORLD,mpiStatus, |
124 |
& rc) |
125 |
ENDIF |
126 |
#endif |
127 |
|
128 |
#ifdef USE_JAM_EXCH |
129 |
northProc = jam_northId |
130 |
southProc = jam_southId |
131 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
132 |
C sendBuf1 = &arr(1,sNy ) |
133 |
C recvBuf1 = &arr(1,sNy+1) |
134 |
C sendBuf2 = &arr(1,1 ) |
135 |
C recvBuf2 = &arr(1,0 ) |
136 |
farProc1 = northProc |
137 |
farProc2 = southProc |
138 |
IF ( farProc1 .NE. myProcId ) THEN |
139 |
CALL JAM_EXCHANGE(farProc1,arr(1,sNy),arr(1,sNy+1), |
140 |
& sNx*8,jam_exchKey) |
141 |
jam_exchKey = jam_exchKey+1 |
142 |
ENDIF |
143 |
IF ( farProc2 .NE. myProcId ) THEN |
144 |
CALL JAM_EXCHANGE(farProc2,arr(1,1),arr(1,0), |
145 |
& sNx*8,jam_exchKey) |
146 |
jam_exchKey = jam_exchKey+1 |
147 |
ENDIF |
148 |
ELSE |
149 |
C sendBuf1 = &arr(1,1 ) |
150 |
C recvBuf1 = &arr(1,0 ) |
151 |
C sendBuf2 = &arr(1,sNy ) |
152 |
C recvBuf2 = &arr(1,sNy+1) |
153 |
farProc1 = southProc |
154 |
farProc2 = northProc |
155 |
IF ( farProc1 .NE. myProcId ) THEN |
156 |
CALL JAM_EXCHANGE(farProc1,arr(1,1),arr(1,0), |
157 |
& sNx*8,jam_exchKey) |
158 |
jam_exchKey = jam_exchKey+1 |
159 |
ENDIF |
160 |
IF ( farProc2 .NE. myProcId ) THEN |
161 |
CALL JAM_EXCHANGE(farProc2,arr(1,sNy),arr(1,sNy+1), |
162 |
& sNx*8,jam_exchKey) |
163 |
jam_exchKey = jam_exchKey+1 |
164 |
ENDIF |
165 |
ENDIF |
166 |
C IF ( farProc1 .NE. myProcId ) THEN |
167 |
C CALL JAM_EXCHANGE(farProc1,sendBuf1,recvBuf1,sNx*8,jam_exchKey) |
168 |
C jam_exchKey = jam_exchKey+1 |
169 |
C ENDIF |
170 |
C IF ( farProc2 .NE. myProcId ) THEN |
171 |
C CALL JAM_EXCHANGE(farProc2,sendBuf2,recvBuf2,sNx*8,jam_exchKey) |
172 |
C jam_exchKey = jam_exchKey+1 |
173 |
C ENDIF |
174 |
#endif |
175 |
|
176 |
#ifdef USE_MPI_EXCH |
177 |
C Fill overlap regions from the buffers |
178 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
179 |
DO I=1,sNx |
180 |
arr(I,sNy+1) = exchBuf1(I) |
181 |
arr(I,0 ) = exchBuf2(I) |
182 |
ENDDO |
183 |
ELSE |
184 |
DO I=1,sNx |
185 |
arr(I,sNy+1) = exchBuf2(I) |
186 |
arr(I,0 ) = exchBuf1(I) |
187 |
ENDDO |
188 |
ENDIF |
189 |
#endif |
190 |
|
191 |
IF ( numberOfProcs .EQ. 1 ) THEN |
192 |
DO I=1,sNx |
193 |
arr(I,sNy+1) = arr(I,1 ) |
194 |
arr(I,0 ) = arr(I,sNy) |
195 |
ENDDO |
196 |
ENDIF |
197 |
|
198 |
RETURN |
199 |
END |
200 |
|
201 |
CBOP |
202 |
C !ROUTINE: EXCH_XY_R8_JAM |
203 |
|
204 |
C !INTERFACE: |
205 |
SUBROUTINE EXCH_XY_R8_JAM( arr ) |
206 |
IMPLICIT NONE |
207 |
|
208 |
C !DESCRIPTION: |
209 |
C *======================================================================* |
210 |
C | SUBROUTINE EXCH_XY_R8_JAM |
211 |
C | o Specialiased JAM binding exchange routine |
212 |
C *======================================================================* |
213 |
C | Routine for high-speed communication directly over JAM library. |
214 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
215 |
C | of width OLy. Operates on 2d array only. Operates on 64-bit fields |
216 |
C | only. |
217 |
C *======================================================================* |
218 |
|
219 |
C !USES: |
220 |
C == Global variables == |
221 |
#include "SIZE.h" |
222 |
#include "EEPARAMS.h" |
223 |
#include "EESUPPORT.h" |
224 |
#include "EXCH_JAM.h" |
225 |
#include "MPI_INFO.h" |
226 |
#include "JAM_INFO.h" |
227 |
|
228 |
C !INPUT/OUTPUT PARAMETERS: |
229 |
C == Routine arguments == |
230 |
C arr :: Array to exchange |
231 |
Real*8 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
232 |
|
233 |
C !LOCAL VARIABLES: |
234 |
C == Local variables == |
235 |
C I,J,iLo,iHi,i0 :: Loop counters |
236 |
C northProc, southProc :: Process id numbers |
237 |
C farProc1, farProc2 |
238 |
C toPid, fromPid |
239 |
C rc :: Error code |
240 |
INTEGER I, J |
241 |
INTEGER iLo, iHi, I0 |
242 |
INTEGER northProc, southProc |
243 |
INTEGER farProc1, farProc2 |
244 |
INTEGER toPid, fromPid |
245 |
INTEGER rc |
246 |
|
247 |
#ifdef ALLOW_MPI |
248 |
C mpiStatus :: MPI error code |
249 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
250 |
#endif |
251 |
CEOP |
252 |
|
253 |
C East-west halo update |
254 |
DO J=1-OLy,sNy+OLy |
255 |
DO I=1,OLx |
256 |
arr(1-I ,J) = arr(sNx-I+1,J) |
257 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
258 |
ENDDO |
259 |
ENDDO |
260 |
|
261 |
C Phase 1 pairing |
262 |
C | 0 | ---> | 1 | |
263 |
C | 0 | <--- | 1 | |
264 |
|
265 |
C | 2 | ---> | 3 | |
266 |
C | 2 | <--- | 3 | |
267 |
|
268 |
C | 4 | ---> | 5 | |
269 |
C | 4 | <--- | 5 | |
270 |
|
271 |
C etc ... |
272 |
C |
273 |
|
274 |
#ifdef USE_MPI_EXCH |
275 |
C North-south halo update (including corners) |
276 |
C Put my edges into a buffers |
277 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
278 |
DO J=1,OLy |
279 |
iLo= 1-OLx |
280 |
iHi= sNx+OLx |
281 |
I0 = (J-1)*(iHi-iLo)+1 |
282 |
DO I=iLo,iHi |
283 |
exchBuf1(I0+I-iLo) = arr(I,sNy-OLy+J) |
284 |
exchBuf2(I0+I-iLo) = arr(I,1+J-1 ) |
285 |
ENDDO |
286 |
ENDDO |
287 |
ELSE |
288 |
DO J=1,OLy |
289 |
iLo= 1-OLx |
290 |
iHi= sNx+OLx |
291 |
I0 = (J-1)*(iHi-iLo)+1 |
292 |
DO I=iLo,iHi |
293 |
exchBuf1(I0+I-iLo) = arr(I,1+J-1 ) |
294 |
exchBuf2(I0+I-iLo) = arr(I,sNy-OLy+J) |
295 |
ENDDO |
296 |
ENDDO |
297 |
ENDIF |
298 |
|
299 |
C Exchange the buffers |
300 |
northProc = mpi_northId |
301 |
southProc = mpi_southId |
302 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
303 |
farProc1 = northProc |
304 |
farProc2 = southProc |
305 |
ELSE |
306 |
farProc1 = southProc |
307 |
farProc2 = northProc |
308 |
ENDIF |
309 |
|
310 |
C Even-odd pairs |
311 |
IF ( farProc1 .NE. myProcId ) THEN |
312 |
CALL MPI_Sendrecv_replace(exchBuf1,OLy*(sNx+2*OLx),MPI_REAL8, |
313 |
& farProc1,0, |
314 |
& farProc1,MPI_ANY_TAG, |
315 |
& MPI_COMM_WORLD,mpiStatus, |
316 |
& rc) |
317 |
ENDIF |
318 |
C Odd-even pairs |
319 |
IF ( farProc2 .NE. myProcId ) THEN |
320 |
CALL MPI_Sendrecv_replace(exchBuf2,OLy*(sNx+2*OLx),MPI_REAL8, |
321 |
& farProc2,0, |
322 |
& farProc2,MPI_ANY_TAG, |
323 |
& MPI_COMM_WORLD,mpiStatus, |
324 |
& rc) |
325 |
ENDIF |
326 |
|
327 |
C Fill overlap regions from the buffers |
328 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
329 |
DO J=1,OLy |
330 |
iLo= 1-OLx |
331 |
iHi= sNx+OLx |
332 |
I0 = (J-1)*(iHi-iLo)+1 |
333 |
DO I=iLo,iHi |
334 |
arr(I,sNy+J ) = exchBuf1(I0+I-iLo) |
335 |
arr(I,1-OLy+J-1) = exchBuf2(I0+I-iLo) |
336 |
ENDDO |
337 |
ENDDO |
338 |
ELSE |
339 |
DO J=1,OLy |
340 |
iLo= 1-OLx |
341 |
iHi= sNx+OLx |
342 |
I0 = (J-1)*(iHi-iLo)+1 |
343 |
DO I=iLo,iHi |
344 |
arr(I,sNy+J ) = exchBuf2(I0+I-iLo) |
345 |
arr(I,1-OLy+J-1 ) = exchBuf1(I0+I-iLo) |
346 |
ENDDO |
347 |
ENDDO |
348 |
ENDIF |
349 |
#endif |
350 |
|
351 |
#ifdef USE_JAM_EXCH |
352 |
northProc = jam_northId |
353 |
southProc = jam_southId |
354 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
355 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
356 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
357 |
C sendBuf2 = &arr(1-OLx,1 ) |
358 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
359 |
farProc1 = northProc |
360 |
farProc2 = southProc |
361 |
IF ( farProc1 .NE. myProcId ) THEN |
362 |
CALL JAM_EXCHANGE(farProc1, |
363 |
& arr(1-OLx,sNy-OLy+1), |
364 |
& arr(1-OLx,sNy+1 ), |
365 |
& OLy*(sNx+2*OLx)*8, |
366 |
& jam_exchKey) |
367 |
jam_exchKey = jam_exchKey+1 |
368 |
ENDIF |
369 |
IF ( farProc2 .NE. myProcId ) THEN |
370 |
CALL JAM_EXCHANGE(farProc2, |
371 |
& arr(1-OLx,1 ), |
372 |
& arr(1-OLx,1-OLy ), |
373 |
& OLy*(sNx+2*OLx)*8, |
374 |
& jam_exchKey) |
375 |
jam_exchKey = jam_exchKey+1 |
376 |
ENDIF |
377 |
ELSE |
378 |
C sendBuf1 = &arr(1-OLx,1 ) |
379 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
380 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
381 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
382 |
farProc1 = southProc |
383 |
farProc2 = northProc |
384 |
IF ( farProc1 .NE. myProcId ) THEN |
385 |
CALL JAM_EXCHANGE(farProc1, |
386 |
& arr(1-OLx,1 ), |
387 |
& arr(1-OLx,1-OLy ), |
388 |
& OLy*(sNx+2*OLx)*8, |
389 |
& jam_exchKey) |
390 |
jam_exchKey = jam_exchKey+1 |
391 |
ENDIF |
392 |
IF ( farProc2 .NE. myProcId ) THEN |
393 |
CALL JAM_EXCHANGE(farProc2, |
394 |
& arr(1-OLx,sNy-OLy+1), |
395 |
& arr(1-OLx,sNy+1 ), |
396 |
& OLy*(sNx+2*OLx)*8, |
397 |
& jam_exchKey) |
398 |
jam_exchKey = jam_exchKey+1 |
399 |
ENDIF |
400 |
ENDIF |
401 |
#endif |
402 |
|
403 |
IF ( numberOfProcs .EQ. 1 ) THEN |
404 |
DO J=1,OLy |
405 |
iLo= 1-OLx |
406 |
iHi= sNx+OLx |
407 |
DO I=iLo,iHi |
408 |
arr(I,sNy+J ) = arr(I,1+J-1 ) |
409 |
arr(I,1-OLy+J-1) = arr(I,sNy-OLy+J) |
410 |
ENDDO |
411 |
ENDDO |
412 |
ENDIF |
413 |
|
414 |
RETURN |
415 |
END |
416 |
CBOP |
417 |
C !ROUTINE: EXCH_XYZ_R8_JAM |
418 |
|
419 |
C !INTERFACE: |
420 |
SUBROUTINE EXCH_XYZ_R8_JAM( arr ) |
421 |
IMPLICIT NONE |
422 |
|
423 |
C !DESCRIPTION: |
424 |
C *======================================================================* |
425 |
C | SUBROUTINE EXCH_XYZ_R8_JAM |
426 |
C | o Specialiased JAM binding exchange routine |
427 |
C *======================================================================* |
428 |
C | Routine for high-speed communication directly over JAM library. |
429 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
430 |
C | of width OLy. Operates on 64-bit fields only. |
431 |
C *======================================================================* |
432 |
|
433 |
C !USES: |
434 |
C == Global variables == |
435 |
#include "SIZE.h" |
436 |
#include "EEPARAMS.h" |
437 |
#include "EESUPPORT.h" |
438 |
#include "EXCH_JAM.h" |
439 |
#include "MPI_INFO.h" |
440 |
#include "JAM_INFO.h" |
441 |
|
442 |
C !INPUT/OUTPUT PARAMETERS: |
443 |
C == Routine arguments == |
444 |
C arr :: Array to exchange |
445 |
Real*8 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr) |
446 |
|
447 |
C !LOCAL VARIABLES: |
448 |
C == Local variables == |
449 |
C I,J,K,iLo,iHi,I0 :: Loop counters |
450 |
C northProc, southProc :: Process id numbers |
451 |
C farProc1, farProc2 |
452 |
C toPid, fromPid |
453 |
C rc :: Error code |
454 |
INTEGER I, J, K |
455 |
INTEGER iLo, iHi, I0 |
456 |
INTEGER northProc, southProc |
457 |
INTEGER farProc1, farProc2 |
458 |
INTEGER toPid, fromPid |
459 |
INTEGER rc |
460 |
|
461 |
#ifdef ALLOW_MPI |
462 |
C mpiStatus :: MPI error code |
463 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
464 |
#endif |
465 |
CEOP |
466 |
|
467 |
C East-west halo update |
468 |
DO K=1,Nr |
469 |
DO J=1-OLy,sNy+OLy |
470 |
DO I=1,OLx |
471 |
arr(1-I ,J,K) = arr(sNx-I+1,J,K) |
472 |
arr(sNx+I,J,K) = arr(1+I-1 ,J,K) |
473 |
ENDDO |
474 |
ENDDO |
475 |
ENDDO |
476 |
|
477 |
C Phase 1 pairing |
478 |
C | 0 | ---> | 1 | |
479 |
C | 0 | <--- | 1 | |
480 |
|
481 |
C | 2 | ---> | 3 | |
482 |
C | 2 | <--- | 3 | |
483 |
|
484 |
C | 4 | ---> | 5 | |
485 |
C | 4 | <--- | 5 | |
486 |
|
487 |
C etc ... |
488 |
C |
489 |
|
490 |
#ifdef USE_MPI_EXCH |
491 |
C North-south halo update (including corners) |
492 |
DO K=1,Nr |
493 |
C Put my edges into a buffers |
494 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
495 |
DO J=1,OLy |
496 |
iLo= 1-OLx |
497 |
iHi= sNx+OLx |
498 |
I0 = (J-1)*(iHi-iLo)+1 |
499 |
DO I=iLo,iHi |
500 |
exchBuf1(I0+I-iLo) = arr(I,sNy-OLy+J,K) |
501 |
exchBuf2(I0+I-iLo) = arr(I,1+J-1 ,K) |
502 |
ENDDO |
503 |
ENDDO |
504 |
ELSE |
505 |
DO J=1,OLy |
506 |
iLo= 1-OLx |
507 |
iHi= sNx+OLx |
508 |
I0 = (J-1)*(iHi-iLo)+1 |
509 |
DO I=iLo,iHi |
510 |
exchBuf1(I0+I-iLo) = arr(I,1+J-1 ,K) |
511 |
exchBuf2(I0+I-iLo) = arr(I,sNy-OLy+J,K) |
512 |
ENDDO |
513 |
ENDDO |
514 |
ENDIF |
515 |
|
516 |
C Exchange the buffers |
517 |
northProc = mpi_northId |
518 |
southProc = mpi_southId |
519 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
520 |
farProc1 = northProc |
521 |
farProc2 = southProc |
522 |
ELSE |
523 |
farProc1 = southProc |
524 |
farProc2 = northProc |
525 |
ENDIF |
526 |
C Even-odd pairs |
527 |
IF ( farProc1 .NE. myProcId ) THEN |
528 |
CALL MPI_Sendrecv_replace(exchBuf1,OLy*(sNx+2*OLx),MPI_REAL8, |
529 |
& farProc1,0, |
530 |
& farProc1,MPI_ANY_TAG, |
531 |
& MPI_COMM_WORLD,mpiStatus, |
532 |
& rc) |
533 |
ENDIF |
534 |
C Odd-even pairs |
535 |
IF ( farProc2 .NE. myProcId ) THEN |
536 |
CALL MPI_Sendrecv_replace(exchBuf2,OLy*(sNx+2*OLx),MPI_REAL8, |
537 |
& farProc2,0, |
538 |
& farProc2,MPI_ANY_TAG, |
539 |
& MPI_COMM_WORLD,mpiStatus, |
540 |
& rc) |
541 |
ENDIF |
542 |
|
543 |
C Fill overlap regions from the buffers |
544 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
545 |
DO J=1,OLy |
546 |
iLo= 1-OLx |
547 |
iHi= sNx+OLx |
548 |
I0 = (J-1)*(iHi-iLo)+1 |
549 |
DO I=iLo,iHi |
550 |
arr(I,sNy+J ,K) = exchBuf1(I0+I-iLo) |
551 |
arr(I,1-OLy+J-1,K) = exchBuf2(I0+I-iLo) |
552 |
ENDDO |
553 |
ENDDO |
554 |
ELSE |
555 |
DO J=1,OLy |
556 |
iLo= 1-OLx |
557 |
iHi= sNx+OLx |
558 |
I0 = (J-1)*(iHi-iLo)+1 |
559 |
DO I=iLo,iHi |
560 |
arr(I,sNy+J ,K) = exchBuf2(I0+I-iLo) |
561 |
arr(I,1-OLy+J-1 ,K) = exchBuf1(I0+I-iLo) |
562 |
ENDDO |
563 |
ENDDO |
564 |
ENDIF |
565 |
ENDDO |
566 |
#endif |
567 |
|
568 |
#ifdef USE_JAM_EXCH |
569 |
northProc = jam_northId |
570 |
southProc = jam_southId |
571 |
DO K=1,Nr |
572 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
573 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
574 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
575 |
C sendBuf2 = &arr(1-OLx,1 ) |
576 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
577 |
farProc1 = northProc |
578 |
farProc2 = southProc |
579 |
IF ( farProc1 .NE. myProcId ) THEN |
580 |
CALL JAM_EXCHANGE(farProc1, |
581 |
& arr(1-OLx,sNy-OLy+1,K), |
582 |
& arr(1-OLx,sNy+1 ,K), |
583 |
& OLy*(sNx+2*OLx)*8, |
584 |
& jam_exchKey) |
585 |
jam_exchKey = jam_exchKey+1 |
586 |
ENDIF |
587 |
IF ( farProc2 .NE. myProcId ) THEN |
588 |
CALL JAM_EXCHANGE(farProc2, |
589 |
& arr(1-OLx,1 ,K), |
590 |
& arr(1-OLx,1-OLy ,K), |
591 |
& OLy*(sNx+2*OLx)*8, |
592 |
& jam_exchKey) |
593 |
jam_exchKey = jam_exchKey+1 |
594 |
ENDIF |
595 |
ELSE |
596 |
C sendBuf1 = &arr(1-OLx,1 ) |
597 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
598 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
599 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
600 |
farProc1 = southProc |
601 |
farProc2 = northProc |
602 |
IF ( farProc1 .NE. myProcId ) THEN |
603 |
CALL JAM_EXCHANGE(farProc1, |
604 |
& arr(1-OLx,1 ,K), |
605 |
& arr(1-OLx,1-OLy ,K), |
606 |
& OLy*(sNx+2*OLx)*8, |
607 |
& jam_exchKey) |
608 |
jam_exchKey = jam_exchKey+1 |
609 |
ENDIF |
610 |
IF ( farProc2 .NE. myProcId ) THEN |
611 |
CALL JAM_EXCHANGE(farProc2, |
612 |
& arr(1-OLx,sNy-OLy+1,K), |
613 |
& arr(1-OLx,sNy+1 ,K), |
614 |
& OLy*(sNx+2*OLx)*8, |
615 |
& jam_exchKey) |
616 |
jam_exchKey = jam_exchKey+1 |
617 |
ENDIF |
618 |
ENDIF |
619 |
ENDDO |
620 |
#endif |
621 |
|
622 |
IF ( numberOfProcs .EQ. 1 ) THEN |
623 |
DO K=1,Nr |
624 |
DO J=1,OLy |
625 |
iLo= 1-OLx |
626 |
iHi= sNx+OLx |
627 |
DO I=iLo,iHi |
628 |
arr(I,sNy+J ,K) = arr(I,1+J-1 ,K) |
629 |
arr(I,1-OLy+J-1,K) = arr(I,sNy-OLy+J,K) |
630 |
ENDDO |
631 |
ENDDO |
632 |
ENDDO |
633 |
ENDIF |
634 |
|
635 |
RETURN |
636 |
END |
637 |
|
638 |
#undef USE_MPI_EXCH |
639 |
#define USE_JAM_EXCH |
640 |
|
641 |
CBOP |
642 |
C !ROUTINE: EXCH_XY_O1_R4_JAM |
643 |
|
644 |
C !INTERFACE: |
645 |
SUBROUTINE EXCH_XY_O1_R4_JAM( arr ) |
646 |
IMPLICIT NONE |
647 |
|
648 |
C !DESCRIPTION: |
649 |
C *======================================================================* |
650 |
C | SUBROUTINE EXCH_XY_O1_R4_JAM |
651 |
C | o Specialiased JAM binding exchange routine |
652 |
C *======================================================================* |
653 |
C | Routine for high-speed communication directly over JAM library. |
654 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
655 |
C | of width 1. Operates on 32-bit fields only. |
656 |
C *======================================================================* |
657 |
|
658 |
C !USES: |
659 |
#define ALLOW_MPI |
660 |
#define _OLx 1 |
661 |
#define _OLy 1 |
662 |
C == Global variables == |
663 |
#include "SIZE.h" |
664 |
#include "EEPARAMS.h" |
665 |
#include "EESUPPORT.h" |
666 |
#include "EXCH_JAM.h" |
667 |
#include "MPI_INFO.h" |
668 |
#include "JAM_INFO.h" |
669 |
|
670 |
C !INPUT/OUTPUT PARAMETERS: |
671 |
C == Routine arguments == |
672 |
C arr :: Array to exchange |
673 |
Real*4 arr(1-_OLx:sNx+_OLx,1-_OLy:sNy+_OLy) |
674 |
|
675 |
C !LOCAL VARIABLES: |
676 |
C == Local variables == |
677 |
INTEGER I, J |
678 |
INTEGER northProc, southProc |
679 |
INTEGER farProc1, farProc2 |
680 |
INTEGER toPid, fromPid |
681 |
INTEGER rc |
682 |
|
683 |
#ifdef ALLOW_MPI |
684 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
685 |
#endif |
686 |
CEOP |
687 |
|
688 |
C East-west halo update (without corners) |
689 |
DO J=1,sNy |
690 |
DO I=1,_OLx |
691 |
arr(1-I ,J) = arr(sNx-I+1,J) |
692 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
693 |
ENDDO |
694 |
ENDDO |
695 |
|
696 |
C Phase 1 pairing |
697 |
C | 0 | ---> | 1 | |
698 |
C | 0 | <--- | 1 | |
699 |
|
700 |
C | 2 | ---> | 3 | |
701 |
C | 2 | <--- | 3 | |
702 |
|
703 |
C | 4 | ---> | 5 | |
704 |
C | 4 | <--- | 5 | |
705 |
|
706 |
C etc ... |
707 |
C |
708 |
|
709 |
#ifdef USE_MPI_EXCH |
710 |
C North-south halo update (without corners) |
711 |
C Put my edges into a buffers |
712 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
713 |
DO I=1,sNx |
714 |
exchBuf1(I) = arr(I,sNy) |
715 |
exchBuf2(I) = arr(I,1 ) |
716 |
ENDDO |
717 |
ELSE |
718 |
DO I=1,sNx |
719 |
exchBuf1(I) = arr(I,1 ) |
720 |
exchBuf2(I) = arr(I,sNy) |
721 |
ENDDO |
722 |
ENDIF |
723 |
|
724 |
C Exchange the buffers |
725 |
northProc = mpi_northId |
726 |
southProc = mpi_southId |
727 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
728 |
farProc1 = northProc |
729 |
farProc2 = southProc |
730 |
ELSE |
731 |
farProc1 = southProc |
732 |
farProc2 = northProc |
733 |
ENDIF |
734 |
C Even-odd pairs |
735 |
IF ( farProc1 .NE. myProcId ) THEN |
736 |
CALL MPI_Sendrecv_replace(exchBuf1,sNx,MPI_REAL8, |
737 |
& farProc1,0, |
738 |
& farProc1,MPI_ANY_TAG, |
739 |
& MPI_COMM_WORLD,mpiStatus, |
740 |
& rc) |
741 |
ENDIF |
742 |
C Odd-even pairs |
743 |
IF ( farProc2 .NE. myProcId ) THEN |
744 |
CALL MPI_Sendrecv_replace(exchBuf2,sNx,MPI_REAL8, |
745 |
& farProc2,0, |
746 |
& farProc2,MPI_ANY_TAG, |
747 |
& MPI_COMM_WORLD,mpiStatus, |
748 |
& rc) |
749 |
ENDIF |
750 |
#endif |
751 |
|
752 |
#ifdef USE_JAM_EXCH |
753 |
northProc = jam_northId |
754 |
southProc = jam_southId |
755 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
756 |
C sendBuf1 = &arr(1,sNy ) |
757 |
C recvBuf1 = &arr(1,sNy+1) |
758 |
C sendBuf2 = &arr(1,1 ) |
759 |
C recvBuf2 = &arr(1,0 ) |
760 |
farProc1 = northProc |
761 |
farProc2 = southProc |
762 |
IF ( farProc1 .NE. myProcId ) THEN |
763 |
CALL JAM_EXCHANGE(farProc1,arr(1,sNy),arr(1,sNy+1), |
764 |
& sNx*4,jam_exchKey) |
765 |
jam_exchKey = jam_exchKey+1 |
766 |
ENDIF |
767 |
IF ( farProc2 .NE. myProcId ) THEN |
768 |
CALL JAM_EXCHANGE(farProc2,arr(1,1),arr(1,0), |
769 |
& sNx*4,jam_exchKey) |
770 |
jam_exchKey = jam_exchKey+1 |
771 |
ENDIF |
772 |
ELSE |
773 |
C sendBuf1 = &arr(1,1 ) |
774 |
C recvBuf1 = &arr(1,0 ) |
775 |
C sendBuf2 = &arr(1,sNy ) |
776 |
C recvBuf2 = &arr(1,sNy+1) |
777 |
farProc1 = southProc |
778 |
farProc2 = northProc |
779 |
IF ( farProc1 .NE. myProcId ) THEN |
780 |
CALL JAM_EXCHANGE(farProc1,arr(1,1),arr(1,0), |
781 |
& sNx*4,jam_exchKey) |
782 |
jam_exchKey = jam_exchKey+1 |
783 |
ENDIF |
784 |
IF ( farProc2 .NE. myProcId ) THEN |
785 |
CALL JAM_EXCHANGE(farProc2,arr(1,sNy),arr(1,sNy+1), |
786 |
& sNx*4,jam_exchKey) |
787 |
jam_exchKey = jam_exchKey+1 |
788 |
ENDIF |
789 |
ENDIF |
790 |
C IF ( farProc1 .NE. myProcId ) THEN |
791 |
C CALL JAM_EXCHANGE(farProc1,sendBuf1,recvBuf1,sNx*8,jam_exchKey) |
792 |
C jam_exchKey = jam_exchKey+1 |
793 |
C ENDIF |
794 |
C IF ( farProc2 .NE. myProcId ) THEN |
795 |
C CALL JAM_EXCHANGE(farProc2,sendBuf2,recvBuf2,sNx*8,jam_exchKey) |
796 |
C jam_exchKey = jam_exchKey+1 |
797 |
C ENDIF |
798 |
#endif |
799 |
|
800 |
#ifdef USE_MPI_EXCH |
801 |
C Fill overlap regions from the buffers |
802 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
803 |
DO I=1,sNx |
804 |
arr(I,sNy+1) = exchBuf1(I) |
805 |
arr(I,0 ) = exchBuf2(I) |
806 |
ENDDO |
807 |
ELSE |
808 |
DO I=1,sNx |
809 |
arr(I,sNy+1) = exchBuf2(I) |
810 |
arr(I,0 ) = exchBuf1(I) |
811 |
ENDDO |
812 |
ENDIF |
813 |
#endif |
814 |
|
815 |
IF ( numberOfProcs .EQ. 1 ) THEN |
816 |
DO I=1,sNx |
817 |
arr(I,sNy+1) = arr(I,1 ) |
818 |
arr(I,0 ) = arr(I,sNy) |
819 |
ENDDO |
820 |
ENDIF |
821 |
|
822 |
RETURN |
823 |
END |
824 |
|
825 |
CBOP |
826 |
C !ROUTINE: EXCH_XY_R4_JAM |
827 |
|
828 |
C !INTERFACE: |
829 |
SUBROUTINE EXCH_XY_R4_JAM( arr ) |
830 |
IMPLICIT NONE |
831 |
|
832 |
C !DESCRIPTION: |
833 |
C *======================================================================* |
834 |
C | SUBROUTINE EXCH_XY_R4_JAM |
835 |
C | o Specialiased JAM binding exchange routine |
836 |
C *======================================================================* |
837 |
C | Routine for high-speed communication directly over JAM library. |
838 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
839 |
C | of width Oly. Operates on two-dimensional, 32-bit fields only. |
840 |
C *======================================================================* |
841 |
|
842 |
C !USES: |
843 |
C == Global variables == |
844 |
#include "SIZE.h" |
845 |
#include "EEPARAMS.h" |
846 |
#include "EESUPPORT.h" |
847 |
#include "EXCH_JAM.h" |
848 |
#include "MPI_INFO.h" |
849 |
#include "JAM_INFO.h" |
850 |
|
851 |
C !INPUT/OUTPUT PARAMETERS: |
852 |
C == Routine arguments == |
853 |
C arr :: Array to exchange |
854 |
Real*4 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
855 |
|
856 |
C !LOCAL VARIABLES: |
857 |
C == Local variables == |
858 |
C I,J,iLo,iHi,i0 :: Loop counters |
859 |
C northProc, southProc :: Process ids |
860 |
C farProc1, farProc2 |
861 |
C toPid, fromPid |
862 |
C rc :: Error code |
863 |
INTEGER I, J |
864 |
INTEGER iLo, iHi, I0 |
865 |
INTEGER northProc, southProc |
866 |
INTEGER farProc1, farProc2 |
867 |
INTEGER toPid, fromPid |
868 |
INTEGER rc |
869 |
#ifdef ALLOW_MPI |
870 |
C mpiStatus :: MPI error code |
871 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
872 |
#endif |
873 |
CEOP |
874 |
|
875 |
C East-west halo update |
876 |
DO J=1-OLy,sNy+OLy |
877 |
DO I=1,OLx |
878 |
arr(1-I ,J) = arr(sNx-I+1,J) |
879 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
880 |
ENDDO |
881 |
ENDDO |
882 |
|
883 |
C Phase 1 pairing |
884 |
C | 0 | ---> | 1 | |
885 |
C | 0 | <--- | 1 | |
886 |
|
887 |
C | 2 | ---> | 3 | |
888 |
C | 2 | <--- | 3 | |
889 |
|
890 |
C | 4 | ---> | 5 | |
891 |
C | 4 | <--- | 5 | |
892 |
|
893 |
C etc ... |
894 |
C |
895 |
|
896 |
#ifdef USE_MPI_EXCH |
897 |
C North-south halo update (including corners) |
898 |
C Put my edges into a buffers |
899 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
900 |
DO J=1,OLy |
901 |
iLo= 1-OLx |
902 |
iHi= sNx+OLx |
903 |
I0 = (J-1)*(iHi-iLo)+1 |
904 |
DO I=iLo,iHi |
905 |
exchBuf1(I0+I-iLo) = arr(I,sNy-OLy+J) |
906 |
exchBuf2(I0+I-iLo) = arr(I,1+J-1 ) |
907 |
ENDDO |
908 |
ENDDO |
909 |
ELSE |
910 |
DO J=1,OLy |
911 |
iLo= 1-OLx |
912 |
iHi= sNx+OLx |
913 |
I0 = (J-1)*(iHi-iLo)+1 |
914 |
DO I=iLo,iHi |
915 |
exchBuf1(I0+I-iLo) = arr(I,1+J-1 ) |
916 |
exchBuf2(I0+I-iLo) = arr(I,sNy-OLy+J) |
917 |
ENDDO |
918 |
ENDDO |
919 |
ENDIF |
920 |
|
921 |
C Exchange the buffers |
922 |
northProc = mpi_northId |
923 |
southProc = mpi_southId |
924 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
925 |
farProc1 = northProc |
926 |
farProc2 = southProc |
927 |
ELSE |
928 |
farProc1 = southProc |
929 |
farProc2 = northProc |
930 |
ENDIF |
931 |
|
932 |
C Even-odd pairs |
933 |
IF ( farProc1 .NE. myProcId ) THEN |
934 |
CALL MPI_Sendrecv_replace(exchBuf1,OLy*(sNx+2*OLx),MPI_REAL8, |
935 |
& farProc1,0, |
936 |
& farProc1,MPI_ANY_TAG, |
937 |
& MPI_COMM_WORLD,mpiStatus, |
938 |
& rc) |
939 |
ENDIF |
940 |
C Odd-even pairs |
941 |
IF ( farProc2 .NE. myProcId ) THEN |
942 |
CALL MPI_Sendrecv_replace(exchBuf2,OLy*(sNx+2*OLx),MPI_REAL8, |
943 |
& farProc2,0, |
944 |
& farProc2,MPI_ANY_TAG, |
945 |
& MPI_COMM_WORLD,mpiStatus, |
946 |
& rc) |
947 |
ENDIF |
948 |
|
949 |
C Fill overlap regions from the buffers |
950 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
951 |
DO J=1,OLy |
952 |
iLo= 1-OLx |
953 |
iHi= sNx+OLx |
954 |
I0 = (J-1)*(iHi-iLo)+1 |
955 |
DO I=iLo,iHi |
956 |
arr(I,sNy+J ) = exchBuf1(I0+I-iLo) |
957 |
arr(I,1-OLy+J-1) = exchBuf2(I0+I-iLo) |
958 |
ENDDO |
959 |
ENDDO |
960 |
ELSE |
961 |
DO J=1,OLy |
962 |
iLo= 1-OLx |
963 |
iHi= sNx+OLx |
964 |
I0 = (J-1)*(iHi-iLo)+1 |
965 |
DO I=iLo,iHi |
966 |
arr(I,sNy+J ) = exchBuf2(I0+I-iLo) |
967 |
arr(I,1-OLy+J-1 ) = exchBuf1(I0+I-iLo) |
968 |
ENDDO |
969 |
ENDDO |
970 |
ENDIF |
971 |
#endif |
972 |
|
973 |
#ifdef USE_JAM_EXCH |
974 |
northProc = jam_northId |
975 |
southProc = jam_southId |
976 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
977 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
978 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
979 |
C sendBuf2 = &arr(1-OLx,1 ) |
980 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
981 |
farProc1 = northProc |
982 |
farProc2 = southProc |
983 |
IF ( farProc1 .NE. myProcId ) THEN |
984 |
CALL JAM_EXCHANGE(farProc1, |
985 |
& arr(1-OLx,sNy-OLy+1), |
986 |
& arr(1-OLx,sNy+1 ), |
987 |
& OLy*(sNx+2*OLx)*4, |
988 |
& jam_exchKey) |
989 |
jam_exchKey = jam_exchKey+1 |
990 |
ENDIF |
991 |
IF ( farProc2 .NE. myProcId ) THEN |
992 |
CALL JAM_EXCHANGE(farProc2, |
993 |
& arr(1-OLx,1 ), |
994 |
& arr(1-OLx,1-OLy ), |
995 |
& OLy*(sNx+2*OLx)*4, |
996 |
& jam_exchKey) |
997 |
jam_exchKey = jam_exchKey+1 |
998 |
ENDIF |
999 |
ELSE |
1000 |
C sendBuf1 = &arr(1-OLx,1 ) |
1001 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
1002 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
1003 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
1004 |
farProc1 = southProc |
1005 |
farProc2 = northProc |
1006 |
IF ( farProc1 .NE. myProcId ) THEN |
1007 |
CALL JAM_EXCHANGE(farProc1, |
1008 |
& arr(1-OLx,1 ), |
1009 |
& arr(1-OLx,1-OLy ), |
1010 |
& OLy*(sNx+2*OLx)*4, |
1011 |
& jam_exchKey) |
1012 |
jam_exchKey = jam_exchKey+1 |
1013 |
ENDIF |
1014 |
IF ( farProc2 .NE. myProcId ) THEN |
1015 |
CALL JAM_EXCHANGE(farProc2, |
1016 |
& arr(1-OLx,sNy-OLy+1), |
1017 |
& arr(1-OLx,sNy+1 ), |
1018 |
& OLy*(sNx+2*OLx)*4, |
1019 |
& jam_exchKey) |
1020 |
jam_exchKey = jam_exchKey+1 |
1021 |
ENDIF |
1022 |
ENDIF |
1023 |
#endif |
1024 |
|
1025 |
IF ( numberOfProcs .EQ. 1 ) THEN |
1026 |
DO J=1,OLy |
1027 |
iLo= 1-OLx |
1028 |
iHi= sNx+OLx |
1029 |
DO I=iLo,iHi |
1030 |
arr(I,sNy+J ) = arr(I,1+J-1 ) |
1031 |
arr(I,1-OLy+J-1) = arr(I,sNy-OLy+J) |
1032 |
ENDDO |
1033 |
ENDDO |
1034 |
ENDIF |
1035 |
|
1036 |
RETURN |
1037 |
END |
1038 |
CBOP |
1039 |
C !ROUTINE: EXCH_XYZ_R4_JAM |
1040 |
|
1041 |
C !INTERFACE: |
1042 |
SUBROUTINE EXCH_XYZ_R4_JAM( arr ) |
1043 |
IMPLICIT NONE |
1044 |
|
1045 |
C !DESCRIPTION: |
1046 |
C *======================================================================* |
1047 |
C | SUBROUTINE EXCH_XYZ_R4_JAM |
1048 |
C | o Specialiased JAM binding exchange routine |
1049 |
C *======================================================================* |
1050 |
C | Routine for high-speed communication directly over JAM library. |
1051 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
1052 |
C | of width Oly. Operates on three-dimensional, 32-bit fields only. |
1053 |
C *======================================================================* |
1054 |
|
1055 |
C !USES: |
1056 |
C == Global variables == |
1057 |
#include "SIZE.h" |
1058 |
#include "EEPARAMS.h" |
1059 |
#include "EESUPPORT.h" |
1060 |
#include "EXCH_JAM.h" |
1061 |
#include "MPI_INFO.h" |
1062 |
#include "JAM_INFO.h" |
1063 |
|
1064 |
C !INPUT/OUTPUT PARAMETERS: |
1065 |
C == Routine arguments == |
1066 |
C arr :: Array to exchange |
1067 |
Real*4 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr) |
1068 |
|
1069 |
C !LOCAL VARIABLES: |
1070 |
C == Local variables == |
1071 |
C I,J,K,iLo,iHi,i0 :: Loop counters |
1072 |
C northProc, southProc :: Process ids |
1073 |
C farProc1, farProc2 |
1074 |
C toPid, fromPid |
1075 |
C rc :: Error code |
1076 |
INTEGER I, J, K |
1077 |
INTEGER iLo, iHi, I0 |
1078 |
INTEGER northProc, southProc |
1079 |
INTEGER farProc1, farProc2 |
1080 |
INTEGER toPid, fromPid |
1081 |
INTEGER rc |
1082 |
#ifdef ALLOW_MPI |
1083 |
C mpiStatus :: MPI error code |
1084 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
1085 |
#endif |
1086 |
CEOP |
1087 |
|
1088 |
C East-west halo update |
1089 |
DO K=1,Nr |
1090 |
DO J=1-OLy,sNy+OLy |
1091 |
DO I=1,OLx |
1092 |
arr(1-I ,J,K) = arr(sNx-I+1,J,K) |
1093 |
arr(sNx+I,J,K) = arr(1+I-1 ,J,K) |
1094 |
ENDDO |
1095 |
ENDDO |
1096 |
ENDDO |
1097 |
|
1098 |
C Phase 1 pairing |
1099 |
C | 0 | ---> | 1 | |
1100 |
C | 0 | <--- | 1 | |
1101 |
|
1102 |
C | 2 | ---> | 3 | |
1103 |
C | 2 | <--- | 3 | |
1104 |
|
1105 |
C | 4 | ---> | 5 | |
1106 |
C | 4 | <--- | 5 | |
1107 |
|
1108 |
C etc ... |
1109 |
C |
1110 |
|
1111 |
#ifdef USE_MPI_EXCH |
1112 |
C North-south halo update (including corners) |
1113 |
DO K=1,Nr |
1114 |
C Put my edges into a buffers |
1115 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1116 |
DO J=1,OLy |
1117 |
iLo= 1-OLx |
1118 |
iHi= sNx+OLx |
1119 |
I0 = (J-1)*(iHi-iLo)+1 |
1120 |
DO I=iLo,iHi |
1121 |
exchBuf1(I0+I-iLo) = arr(I,sNy-OLy+J,K) |
1122 |
exchBuf2(I0+I-iLo) = arr(I,1+J-1 ,K) |
1123 |
ENDDO |
1124 |
ENDDO |
1125 |
ELSE |
1126 |
DO J=1,OLy |
1127 |
iLo= 1-OLx |
1128 |
iHi= sNx+OLx |
1129 |
I0 = (J-1)*(iHi-iLo)+1 |
1130 |
DO I=iLo,iHi |
1131 |
exchBuf1(I0+I-iLo) = arr(I,1+J-1 ,K) |
1132 |
exchBuf2(I0+I-iLo) = arr(I,sNy-OLy+J,K) |
1133 |
ENDDO |
1134 |
ENDDO |
1135 |
ENDIF |
1136 |
|
1137 |
C Exchange the buffers |
1138 |
northProc = mpi_northId |
1139 |
southProc = mpi_southId |
1140 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1141 |
farProc1 = northProc |
1142 |
farProc2 = southProc |
1143 |
ELSE |
1144 |
farProc1 = southProc |
1145 |
farProc2 = northProc |
1146 |
ENDIF |
1147 |
C Even-odd pairs |
1148 |
IF ( farProc1 .NE. myProcId ) THEN |
1149 |
CALL MPI_Sendrecv_replace(exchBuf1,OLy*(sNx+2*OLx),MPI_REAL8, |
1150 |
& farProc1,0, |
1151 |
& farProc1,MPI_ANY_TAG, |
1152 |
& MPI_COMM_WORLD,mpiStatus, |
1153 |
& rc) |
1154 |
ENDIF |
1155 |
C Odd-even pairs |
1156 |
IF ( farProc2 .NE. myProcId ) THEN |
1157 |
CALL MPI_Sendrecv_replace(exchBuf2,OLy*(sNx+2*OLx),MPI_REAL8, |
1158 |
& farProc2,0, |
1159 |
& farProc2,MPI_ANY_TAG, |
1160 |
& MPI_COMM_WORLD,mpiStatus, |
1161 |
& rc) |
1162 |
ENDIF |
1163 |
|
1164 |
C Fill overlap regions from the buffers |
1165 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1166 |
DO J=1,OLy |
1167 |
iLo= 1-OLx |
1168 |
iHi= sNx+OLx |
1169 |
I0 = (J-1)*(iHi-iLo)+1 |
1170 |
DO I=iLo,iHi |
1171 |
arr(I,sNy+J ,K) = exchBuf1(I0+I-iLo) |
1172 |
arr(I,1-OLy+J-1,K) = exchBuf2(I0+I-iLo) |
1173 |
ENDDO |
1174 |
ENDDO |
1175 |
ELSE |
1176 |
DO J=1,OLy |
1177 |
iLo= 1-OLx |
1178 |
iHi= sNx+OLx |
1179 |
I0 = (J-1)*(iHi-iLo)+1 |
1180 |
DO I=iLo,iHi |
1181 |
arr(I,sNy+J ,K) = exchBuf2(I0+I-iLo) |
1182 |
arr(I,1-OLy+J-1 ,K) = exchBuf1(I0+I-iLo) |
1183 |
ENDDO |
1184 |
ENDDO |
1185 |
ENDIF |
1186 |
ENDDO |
1187 |
#endif |
1188 |
|
1189 |
#ifdef USE_JAM_EXCH |
1190 |
northProc = jam_northId |
1191 |
southProc = jam_southId |
1192 |
DO K=1,Nr |
1193 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1194 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
1195 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
1196 |
C sendBuf2 = &arr(1-OLx,1 ) |
1197 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
1198 |
farProc1 = northProc |
1199 |
farProc2 = southProc |
1200 |
IF ( farProc1 .NE. myProcId ) THEN |
1201 |
CALL JAM_EXCHANGE(farProc1, |
1202 |
& arr(1-OLx,sNy-OLy+1,K), |
1203 |
& arr(1-OLx,sNy+1 ,K), |
1204 |
& OLy*(sNx+2*OLx)*4, |
1205 |
& jam_exchKey) |
1206 |
jam_exchKey = jam_exchKey+1 |
1207 |
ENDIF |
1208 |
IF ( farProc2 .NE. myProcId ) THEN |
1209 |
CALL JAM_EXCHANGE(farProc2, |
1210 |
& arr(1-OLx,1 ,K), |
1211 |
& arr(1-OLx,1-OLy ,K), |
1212 |
& OLy*(sNx+2*OLx)*4, |
1213 |
& jam_exchKey) |
1214 |
jam_exchKey = jam_exchKey+1 |
1215 |
ENDIF |
1216 |
ELSE |
1217 |
C sendBuf1 = &arr(1-OLx,1 ) |
1218 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
1219 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
1220 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
1221 |
farProc1 = southProc |
1222 |
farProc2 = northProc |
1223 |
IF ( farProc1 .NE. myProcId ) THEN |
1224 |
CALL JAM_EXCHANGE(farProc1, |
1225 |
& arr(1-OLx,1 ,K), |
1226 |
& arr(1-OLx,1-OLy ,K), |
1227 |
& OLy*(sNx+2*OLx)*4, |
1228 |
& jam_exchKey) |
1229 |
jam_exchKey = jam_exchKey+1 |
1230 |
ENDIF |
1231 |
IF ( farProc2 .NE. myProcId ) THEN |
1232 |
CALL JAM_EXCHANGE(farProc2, |
1233 |
& arr(1-OLx,sNy-OLy+1,K), |
1234 |
& arr(1-OLx,sNy+1 ,K), |
1235 |
& OLy*(sNx+2*OLx)*4, |
1236 |
& jam_exchKey) |
1237 |
jam_exchKey = jam_exchKey+1 |
1238 |
ENDIF |
1239 |
ENDIF |
1240 |
ENDDO |
1241 |
#endif |
1242 |
|
1243 |
IF ( numberOfProcs .EQ. 1 ) THEN |
1244 |
DO K=1,Nr |
1245 |
DO J=1,OLy |
1246 |
iLo= 1-OLx |
1247 |
iHi= sNx+OLx |
1248 |
DO I=iLo,iHi |
1249 |
arr(I,sNy+J ,K) = arr(I,1+J-1 ,K) |
1250 |
arr(I,1-OLy+J-1,K) = arr(I,sNy-OLy+J,K) |
1251 |
ENDDO |
1252 |
ENDDO |
1253 |
ENDDO |
1254 |
ENDIF |
1255 |
|
1256 |
#endif /* LETS_MAKE_JAM */ |
1257 |
|
1258 |
RETURN |
1259 |
END |
1260 |
|
1261 |
#endif /* JAM_WITH_TWO_PROCS_PER_NODE */ |
1262 |
#ifdef JAM_WITH_TWO_PROCS_PER_NODE |
1263 |
C Dual processor JAM stuff |
1264 |
|
1265 |
#undef USE_MPI_EXCH |
1266 |
#define USE_JAM_EXCH |
1267 |
CBOP |
1268 |
C !ROUTINE: EXCH_XY_O1_R8_JAM |
1269 |
|
1270 |
C !INTERFACE: |
1271 |
SUBROUTINE EXCH_XY_O1_R8_JAM( arr ) |
1272 |
IMPLICIT NONE |
1273 |
|
1274 |
C !DESCRIPTION: |
1275 |
C *======================================================================* |
1276 |
C | SUBROUTINE EXCH_XY_O1_R8_JAM |
1277 |
C | o Specialiased JAM binding exchange routine for dual-proc SMP node. |
1278 |
C *======================================================================* |
1279 |
C | Routine for high-speed communication directly over JAM library. |
1280 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
1281 |
C | of width 1. Operates on two-dimensional, 64-bit fields only. |
1282 |
C *======================================================================* |
1283 |
|
1284 |
C !USES: |
1285 |
#define ALLOW_MPI |
1286 |
#define _OLx 1 |
1287 |
#define _OLy 1 |
1288 |
C == Global variables == |
1289 |
#include "SIZE.h" |
1290 |
#include "EEPARAMS.h" |
1291 |
#include "EXCH_JAM.h" |
1292 |
#include "MPI_INFO.h" |
1293 |
#include "JAM_INFO.h" |
1294 |
|
1295 |
C !INPUT/OUTPUT PARAMETERS: |
1296 |
C == Routine arguments == |
1297 |
C arr :: Array to exchange |
1298 |
Real*8 arr(1-_OLx:sNx+_OLx,1-_OLy:sNy+_OLy) |
1299 |
|
1300 |
C !LOCAL VARIABLES: |
1301 |
C == Local variables == |
1302 |
C I, J :: Loop counters |
1303 |
C northProc, southProc :: Process id numbers |
1304 |
C farProc1, farProc2 |
1305 |
C toPid, fromPid |
1306 |
C rc :: Error code |
1307 |
C myFourWayRank :: Code indicating ranking in four |
1308 |
C member subgroup of processes |
1309 |
C exchangePhase :: Step counter for multi-stage exchange. |
1310 |
INTEGER I, J |
1311 |
INTEGER northProc, southProc |
1312 |
INTEGER farProc1, farProc2 |
1313 |
INTEGER toPid, fromPid |
1314 |
INTEGER rc |
1315 |
INTEGER myFourWayRank |
1316 |
INTEGER exchangePhase |
1317 |
CEOP |
1318 |
|
1319 |
C East-west halo update (without corners) |
1320 |
DO J=1,sNy |
1321 |
DO I=1,_OLx |
1322 |
arr(1-I ,J) = arr(sNx-I+1,J) |
1323 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
1324 |
ENDDO |
1325 |
ENDDO |
1326 |
|
1327 |
C Phase 1 pairing |
1328 |
C | 0 | ---> | 1 | |
1329 |
C | 0 | <--- | 1 | |
1330 |
|
1331 |
C | 2 | ---> | 3 | |
1332 |
C | 2 | <--- | 3 | |
1333 |
|
1334 |
C | 4 | ---> | 5 | |
1335 |
C | 4 | <--- | 5 | |
1336 |
|
1337 |
C etc ... |
1338 |
C |
1339 |
|
1340 |
#ifdef USE_JAM_EXCH |
1341 |
northProc = jam_northId |
1342 |
southProc = jam_southId |
1343 |
myFourWayRank = MOD(myProcId,4) |
1344 |
|
1345 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1346 |
farProc1 = northProc |
1347 |
farProc2 = southProc |
1348 |
IF ( farProc1 .NE. myProcId ) THEN |
1349 |
CALL JAM_EXCHANGE(farProc1,arr(1,sNy),arr(1,sNy+1), |
1350 |
& sNx*8,jam_exchKey) |
1351 |
jam_exchKey = jam_exchKey+1 |
1352 |
ENDIF |
1353 |
10 CONTINUE |
1354 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1355 |
IF ( myFourWayRank .EQ. 0 ) THEN |
1356 |
IF ( exchangePhase .EQ. 0 ) GOTO 11 |
1357 |
ELSE |
1358 |
IF ( exchangePhase .EQ. 1 ) GOTO 11 |
1359 |
ENDIF |
1360 |
GOTO 10 |
1361 |
11 CONTINUE |
1362 |
IF ( farProc2 .NE. myProcId ) THEN |
1363 |
CALL JAM_EXCHANGE(farProc2,arr(1,1),arr(1,0),sNx*8,jam_exchKey) |
1364 |
jam_exchKey = jam_exchKey+1 |
1365 |
ENDIF |
1366 |
CALL JAM_EXCHANGE_MARK |
1367 |
ELSE |
1368 |
farProc1 = southProc |
1369 |
farProc2 = northProc |
1370 |
IF ( farProc1 .NE. myProcId ) THEN |
1371 |
CALL JAM_EXCHANGE(farProc1,arr(1,1),arr(1,0),sNx*8,jam_exchKey) |
1372 |
jam_exchKey = jam_exchKey+1 |
1373 |
ENDIF |
1374 |
20 CONTINUE |
1375 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1376 |
IF ( myFourWayRank .EQ. 3 ) THEN |
1377 |
IF ( exchangePhase .EQ. 0 ) GOTO 21 |
1378 |
ELSE |
1379 |
IF ( exchangePhase .EQ. 1 ) GOTO 21 |
1380 |
ENDIF |
1381 |
GOTO 20 |
1382 |
21 CONTINUE |
1383 |
IF ( farProc2 .NE. myProcId ) THEN |
1384 |
CALL JAM_EXCHANGE(farProc2,arr(1,sNy),arr(1,sNy+1), |
1385 |
& sNx*8,jam_exchKey) |
1386 |
jam_exchKey = jam_exchKey+1 |
1387 |
ENDIF |
1388 |
CALL JAM_EXCHANGE_MARK |
1389 |
ENDIF |
1390 |
#endif |
1391 |
|
1392 |
RETURN |
1393 |
END |
1394 |
|
1395 |
CBOP |
1396 |
C !ROUTINE: EXCH_XY_R8_JAM |
1397 |
|
1398 |
C !INTERFACE: |
1399 |
SUBROUTINE EXCH_XY_R8_JAM( arr ) |
1400 |
IMPLICIT NONE |
1401 |
|
1402 |
C !DESCRIPTION: |
1403 |
C *======================================================================* |
1404 |
C | SUBROUTINE EXCH_XY_R8_JAM |
1405 |
C | o Specialiased JAM binding exchange routine for dual-proc SMP node. |
1406 |
C *======================================================================* |
1407 |
C | Routine for high-speed communication directly over JAM library. |
1408 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
1409 |
C | of width OLy. Operates on two-dimensional, 64-bit fields only. |
1410 |
C *======================================================================* |
1411 |
|
1412 |
C !USES: |
1413 |
C == Global variables == |
1414 |
#include "SIZE.h" |
1415 |
#include "EEPARAMS.h" |
1416 |
#include "EESUPPORT.h" |
1417 |
#include "EXCH_JAM.h" |
1418 |
#include "MPI_INFO.h" |
1419 |
#include "JAM_INFO.h" |
1420 |
|
1421 |
C !INPUT/OUTPUT PARAMETERS: |
1422 |
C == Routine arguments == |
1423 |
C arr :: Array to exchange |
1424 |
Real*8 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
1425 |
|
1426 |
C !LOCAL VARIABLES: |
1427 |
C == Local variables == |
1428 |
C I,J,iLo,iHi,I0 :: Loop counter |
1429 |
C northProc, southProc :: Process id |
1430 |
C farProc1, farProc2 |
1431 |
C toPid, fromPid |
1432 |
C rc :: Error code |
1433 |
C myFourWayRank :: Code indicating ranking in four |
1434 |
C member subgroup of processes |
1435 |
C exchangePhase :: Step counter for multi-stage exchange. |
1436 |
INTEGER I, J |
1437 |
INTEGER iLo, iHi, I0 |
1438 |
INTEGER northProc, southProc |
1439 |
INTEGER farProc1, farProc2 |
1440 |
INTEGER toPid, fromPid |
1441 |
INTEGER rc |
1442 |
INTEGER myFourWayRank, exchangePhase |
1443 |
|
1444 |
#ifdef ALLOW_MPI |
1445 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
1446 |
#endif |
1447 |
CEOP |
1448 |
|
1449 |
C East-west halo update |
1450 |
DO J=1-OLy,sNy+OLy |
1451 |
DO I=1,OLx |
1452 |
arr(1-I ,J) = arr(sNx-I+1,J) |
1453 |
arr(sNx+I,J) = arr(1+I-1 ,J) |
1454 |
ENDDO |
1455 |
ENDDO |
1456 |
|
1457 |
C Phase 1 pairing |
1458 |
C | 0 | ---> | 1 | |
1459 |
C | 0 | <--- | 1 | |
1460 |
|
1461 |
C | 2 | ---> | 3 | |
1462 |
C | 2 | <--- | 3 | |
1463 |
|
1464 |
C | 4 | ---> | 5 | |
1465 |
C | 4 | <--- | 5 | |
1466 |
|
1467 |
C etc ... |
1468 |
C |
1469 |
|
1470 |
#ifdef USE_JAM_EXCH |
1471 |
northProc = jam_northId |
1472 |
southProc = jam_southId |
1473 |
myFourWayRank = MOD(myProcId,4) |
1474 |
|
1475 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1476 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
1477 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
1478 |
C sendBuf2 = &arr(1-OLx,1 ) |
1479 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
1480 |
farProc1 = northProc |
1481 |
farProc2 = southProc |
1482 |
IF ( farProc1 .NE. myProcId ) THEN |
1483 |
CALL JAM_EXCHANGE(farProc1, |
1484 |
& arr(1-OLx,sNy-OLy+1), |
1485 |
& arr(1-OLx,sNy+1 ), |
1486 |
& OLy*(sNx+2*OLx)*8, |
1487 |
& jam_exchKey) |
1488 |
jam_exchKey = jam_exchKey+1 |
1489 |
ENDIF |
1490 |
10 CONTINUE |
1491 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1492 |
IF ( myFourWayRank .EQ. 0 ) THEN |
1493 |
IF ( exchangePhase .EQ. 0 ) GOTO 11 |
1494 |
ELSE |
1495 |
IF ( exchangePhase .EQ. 1 ) GOTO 11 |
1496 |
ENDIF |
1497 |
GOTO 10 |
1498 |
11 CONTINUE |
1499 |
IF ( farProc2 .NE. myProcId ) THEN |
1500 |
CALL JAM_EXCHANGE(farProc2, |
1501 |
& arr(1-OLx,1 ), |
1502 |
& arr(1-OLx,1-OLy ), |
1503 |
& OLy*(sNx+2*OLx)*8, |
1504 |
& jam_exchKey) |
1505 |
jam_exchKey = jam_exchKey+1 |
1506 |
ENDIF |
1507 |
CALL JAM_EXCHANGE_MARK |
1508 |
ELSE |
1509 |
C sendBuf1 = &arr(1-OLx,1 ) |
1510 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
1511 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
1512 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
1513 |
farProc1 = southProc |
1514 |
farProc2 = northProc |
1515 |
IF ( farProc1 .NE. myProcId ) THEN |
1516 |
CALL JAM_EXCHANGE(farProc1, |
1517 |
& arr(1-OLx,1 ), |
1518 |
& arr(1-OLx,1-OLy ), |
1519 |
& OLy*(sNx+2*OLx)*8, |
1520 |
& jam_exchKey) |
1521 |
jam_exchKey = jam_exchKey+1 |
1522 |
ENDIF |
1523 |
20 CONTINUE |
1524 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1525 |
IF ( myFourWayRank .EQ. 3 ) THEN |
1526 |
IF ( exchangePhase .EQ. 0 ) GOTO 21 |
1527 |
ELSE |
1528 |
IF ( exchangePhase .EQ. 1 ) GOTO 21 |
1529 |
ENDIF |
1530 |
GOTO 20 |
1531 |
21 CONTINUE |
1532 |
IF ( farProc2 .NE. myProcId ) THEN |
1533 |
CALL JAM_EXCHANGE(farProc2, |
1534 |
& arr(1-OLx,sNy-OLy+1), |
1535 |
& arr(1-OLx,sNy+1 ), |
1536 |
& OLy*(sNx+2*OLx)*8, |
1537 |
& jam_exchKey) |
1538 |
jam_exchKey = jam_exchKey+1 |
1539 |
ENDIF |
1540 |
CALL JAM_EXCHANGE_MARK |
1541 |
ENDIF |
1542 |
#endif |
1543 |
|
1544 |
RETURN |
1545 |
END |
1546 |
CBOP |
1547 |
C !ROUTINE: EXCH_XYZ_R8_JAM |
1548 |
|
1549 |
C !INTERFACE: |
1550 |
SUBROUTINE EXCH_XYZ_R8_JAM( arr ) |
1551 |
IMPLICIT NONE |
1552 |
|
1553 |
C !DESCRIPTION: |
1554 |
C *======================================================================* |
1555 |
C | SUBROUTINE EXCH_XYZ_R8_JAM |
1556 |
C | o Specialiased JAM binding exchange routine for dual-proc SMP node. |
1557 |
C *======================================================================* |
1558 |
C | Routine for high-speed communication directly over JAM library. |
1559 |
C | Communication is coded for decomposition in Y only as. Overlaps are |
1560 |
C | of width OLy. Operates on three-dimensional, 64-bit fields only. |
1561 |
C *======================================================================* |
1562 |
|
1563 |
C !USES: |
1564 |
C == Global variables == |
1565 |
#include "SIZE.h" |
1566 |
#include "EEPARAMS.h" |
1567 |
#include "EESUPPORT.h" |
1568 |
#include "EXCH_JAM.h" |
1569 |
#include "MPI_INFO.h" |
1570 |
#include "JAM_INFO.h" |
1571 |
|
1572 |
C !INPUT/OUTPUT PARAMETERS: |
1573 |
C == Routine arguments == |
1574 |
C arr :: Array to exchange |
1575 |
Real*8 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr) |
1576 |
|
1577 |
C !LOCAL VARIABLES: |
1578 |
C == Local variables == |
1579 |
C I,J,K,iHi,iLo,I0 :: Loop counters |
1580 |
C northProc, southProc :: Process ids |
1581 |
C farProc1, farProc2 |
1582 |
C toPid, fromPid |
1583 |
C rc :: Error code |
1584 |
C myFourWayRank :: Code indicating ranking in four |
1585 |
C member subgroup of processes |
1586 |
C exchangePhase :: Step counter for multi-stage exchange. |
1587 |
INTEGER I, J, K |
1588 |
INTEGER iLo, iHi, I0 |
1589 |
INTEGER northProc, southProc |
1590 |
INTEGER farProc1, farProc2 |
1591 |
INTEGER toPid, fromPid |
1592 |
INTEGER rc |
1593 |
INTEGER myFourWayRank, exchangePhase |
1594 |
#ifdef ALLOW_MPI |
1595 |
C mpiStatus :: MPI error code |
1596 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
1597 |
#endif |
1598 |
CEOP |
1599 |
|
1600 |
C East-west halo update |
1601 |
DO K=1,Nr |
1602 |
DO J=1-OLy,sNy+OLy |
1603 |
DO I=1,OLx |
1604 |
arr(1-I ,J,K) = arr(sNx-I+1,J,K) |
1605 |
arr(sNx+I,J,K) = arr(1+I-1 ,J,K) |
1606 |
ENDDO |
1607 |
ENDDO |
1608 |
ENDDO |
1609 |
|
1610 |
CcnhDebugStarts |
1611 |
C RETURN |
1612 |
CcnhDebugEnds |
1613 |
|
1614 |
C Phase 1 pairing |
1615 |
C | 0 | ---> | 1 | |
1616 |
C | 0 | <--- | 1 | |
1617 |
|
1618 |
C | 2 | ---> | 3 | |
1619 |
C | 2 | <--- | 3 | |
1620 |
|
1621 |
C | 4 | ---> | 5 | |
1622 |
C | 4 | <--- | 5 | |
1623 |
|
1624 |
C etc ... |
1625 |
C |
1626 |
|
1627 |
|
1628 |
#ifdef USE_JAM_EXCH |
1629 |
northProc = jam_northId |
1630 |
southProc = jam_southId |
1631 |
myFourWayRank = MOD(myProcId,4) |
1632 |
|
1633 |
DO K=1,Nr |
1634 |
IF ( MOD(myProcId,2) .EQ. 0 ) THEN |
1635 |
C sendBuf1 = &arr(1-OLx,sNy-OLy+1) |
1636 |
C recvBuf1 = &arr(1-OLx,sNy+1 ) |
1637 |
C sendBuf2 = &arr(1-OLx,1 ) |
1638 |
C recvBuf2 = &arr(1-OLx,1-OLy ) |
1639 |
farProc1 = northProc |
1640 |
farProc2 = southProc |
1641 |
IF ( farProc1 .NE. myProcId ) THEN |
1642 |
CALL JAM_EXCHANGE(farProc1, |
1643 |
& arr(1-OLx,sNy-OLy+1,K), |
1644 |
& arr(1-OLx,sNy+1 ,K), |
1645 |
& OLy*(sNx+2*OLx)*8, |
1646 |
& jam_exchKey) |
1647 |
jam_exchKey = jam_exchKey+1 |
1648 |
ENDIF |
1649 |
10 CONTINUE |
1650 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1651 |
IF ( myFourWayRank .EQ. 0 ) THEN |
1652 |
IF ( exchangePhase .EQ. 0 ) GOTO 11 |
1653 |
ELSE |
1654 |
IF ( exchangePhase .EQ. 1 ) GOTO 11 |
1655 |
ENDIF |
1656 |
GOTO 10 |
1657 |
11 CONTINUE |
1658 |
IF ( farProc2 .NE. myProcId ) THEN |
1659 |
CALL JAM_EXCHANGE(farProc2, |
1660 |
& arr(1-OLx,1 ,K), |
1661 |
& arr(1-OLx,1-OLy ,K), |
1662 |
& OLy*(sNx+2*OLx)*8, |
1663 |
& jam_exchKey) |
1664 |
jam_exchKey = jam_exchKey+1 |
1665 |
ENDIF |
1666 |
CALL JAM_EXCHANGE_MARK |
1667 |
ELSE |
1668 |
C sendBuf1 = &arr(1-OLx,1 ) |
1669 |
C recvBuf1 = &arr(1-OLx,1-OLy ) |
1670 |
C sendBuf2 = &arr(1-OLx,sNy-OLy+1) |
1671 |
C recvBuf2 = &arr(1-OLx,sNy+1 ) |
1672 |
farProc1 = southProc |
1673 |
farProc2 = northProc |
1674 |
IF ( farProc1 .NE. myProcId ) THEN |
1675 |
CALL JAM_EXCHANGE(farProc1, |
1676 |
& arr(1-OLx,1 ,K), |
1677 |
& arr(1-OLx,1-OLy ,K), |
1678 |
& OLy*(sNx+2*OLx)*8, |
1679 |
& jam_exchKey) |
1680 |
jam_exchKey = jam_exchKey+1 |
1681 |
ENDIF |
1682 |
20 CONTINUE |
1683 |
CALL JAM_EXCHANGE_TEST( exchangePhase ) |
1684 |
IF ( myFourWayRank .EQ. 3 ) THEN |
1685 |
IF ( exchangePhase .EQ. 0 ) GOTO 21 |
1686 |
ELSE |
1687 |
IF ( exchangePhase .EQ. 1 ) GOTO 21 |
1688 |
ENDIF |
1689 |
GOTO 20 |
1690 |
21 CONTINUE |
1691 |
IF ( farProc2 .NE. myProcId ) THEN |
1692 |
CALL JAM_EXCHANGE(farProc2, |
1693 |
& arr(1-OLx,sNy-OLy+1,K), |
1694 |
& arr(1-OLx,sNy+1 ,K), |
1695 |
& OLy*(sNx+2*OLx)*8, |
1696 |
& jam_exchKey) |
1697 |
jam_exchKey = jam_exchKey+1 |
1698 |
ENDIF |
1699 |
CALL JAM_EXCHANGE_MARK |
1700 |
ENDIF |
1701 |
ENDDO |
1702 |
#endif |
1703 |
|
1704 |
RETURN |
1705 |
END |
1706 |
|
1707 |
#endif /* JAM_WITH_TWO_PROCS_PER_NODE */ |