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