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

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

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

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