/[MITgcm]/MITgcm/eesupp/src/exch_jam.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/exch_jam.F

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

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