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