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

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

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

Revision 1.1 - (hide 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 adcroft 1.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