1 |
C $Header: $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "CPP_OPTIONS.h" |
5 |
|
6 |
subroutine exch_allgather_2d_rl( |
7 |
I arr |
8 |
O , full |
9 |
I , mythid |
10 |
& ) |
11 |
|
12 |
c ================================================================== |
13 |
c SUBROUTINE exch_allgather_2d_rl |
14 |
c ================================================================== |
15 |
c |
16 |
c o exchange local domains of a distributed 2d field |
17 |
c so that every processor has the whole field |
18 |
c |
19 |
c started: Ralf Giering Ralf.Giering@FastOpt.de 12-Jun-2001 |
20 |
c |
21 |
c ================================================================== |
22 |
c SUBROUTINE exch_allgather_2d_rl |
23 |
c ================================================================== |
24 |
implicit none |
25 |
|
26 |
c == global variables == |
27 |
|
28 |
#include "EEPARAMS.h" |
29 |
#include "SIZE.h" |
30 |
#include "EESUPPORT.h" |
31 |
#include "EXCH.h" |
32 |
|
33 |
c == routine arguments == |
34 |
|
35 |
_RL arr ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy ) |
36 |
_RL full( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy, nPx, nPy ) |
37 |
integer mythid |
38 |
|
39 |
c == local variables == |
40 |
#ifdef ALLOW_USE_MPI |
41 |
integer mpirc |
42 |
integer mpicrd(2) |
43 |
integer ipx, ipy |
44 |
|
45 |
_RL recvbuf( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy, nPx*nPy ) |
46 |
|
47 |
integer sendsize |
48 |
parameter( sendsize = sNx*sNy*nSx*nSy ) |
49 |
integer recvsize |
50 |
parameter( recvsize = sNx*sNy*nSx*nSy ) |
51 |
|
52 |
integer iproc |
53 |
integer bi, bj |
54 |
integer i, j |
55 |
#endif |
56 |
|
57 |
C-- Can not start until everyone is ready |
58 |
_BARRIER |
59 |
|
60 |
c-- Only the master thread is doing communication |
61 |
_BEGIN_MASTER( myThid ) |
62 |
|
63 |
#ifdef ALLOW_USE_MPI |
64 |
#ifndef ALWAYS_USE_MPI |
65 |
IF ( usingMPI ) THEN |
66 |
#endif |
67 |
|
68 |
call MPI_Allgather( arr , sendsize, MPI_DOUBLE_PRECISION |
69 |
& , recvbuf, recvsize, MPI_DOUBLE_PRECISION |
70 |
& , MPI_COMM_MODEL, mpiRC |
71 |
& ) |
72 |
|
73 |
c-- arrange array according to cartesian coordinates of processors |
74 |
do iproc = 1, numberOfProcs |
75 |
|
76 |
c-- get coordinates of processor (iporc-1) |
77 |
call MPI_Cart_coords( |
78 |
I MPI_COMM_MODEL, iproc-1, 2, mpicrd |
79 |
O , mpirc |
80 |
& ) |
81 |
|
82 |
ipx = 1 + mpicrd(1) |
83 |
ipy = 1 + mpicrd(2) |
84 |
|
85 |
do bj = 1, nSy |
86 |
do bi = 1, nSx |
87 |
do j = 1, sNy |
88 |
do i = 1, sNx |
89 |
full(i,j,bi,bj,ipx,ipy) = recvbuf(i,j,bi,bj,iproc) |
90 |
enddo |
91 |
enddo |
92 |
enddo |
93 |
enddo |
94 |
|
95 |
enddo |
96 |
|
97 |
#ifndef ALWAYS_USE_MPI |
98 |
ENDIF |
99 |
#endif |
100 |
#endif /* ALLOW_USE_MPI */ |
101 |
|
102 |
c-- end of master thread only computations |
103 |
_END_MASTER( myThid ) |
104 |
|
105 |
_BARRIER |
106 |
|
107 |
end |
108 |
|