2 c---------------------------------------------------------------------
3 c---------------------------------------------------------------------
7 c---------------------------------------------------------------------
8 c---------------------------------------------------------------------
10 c---------------------------------------------------------------------
11 c this function copies the face values of a variable defined on a set
12 c of cells to the overlap locations of the adjacent sets of cells.
13 c Because a set of cells interfaces in each direction with exactly one
14 c other set, we only need to fill six different buffers. We could try to
15 c overlap communication with computation, by computing
16 c some internal values while communicating boundary values, but this
17 c adds so much overhead that it's not clearly useful.
18 c---------------------------------------------------------------------
23 integer i, j, k, c, m, requests(0:11), p0, p1,
24 > p2, p3, p4, p5, b_size(0:5), ss(0:5),
25 > sr(0:5), error, statuses(MPI_STATUS_SIZE, 0:11)
27 c---------------------------------------------------------------------
28 c exit immediately if there are no faces to be copied
29 c---------------------------------------------------------------------
30 if (no_nodes .eq. 1) then
36 ss(0) = start_send_east
37 ss(1) = start_send_west
38 ss(2) = start_send_north
39 ss(3) = start_send_south
40 ss(4) = start_send_top
41 ss(5) = start_send_bottom
43 sr(0) = start_recv_east
44 sr(1) = start_recv_west
45 sr(2) = start_recv_north
46 sr(3) = start_recv_south
47 sr(4) = start_recv_top
48 sr(5) = start_recv_bottom
52 b_size(2) = north_size
53 b_size(3) = south_size
55 b_size(5) = bottom_size
57 c---------------------------------------------------------------------
58 c because the difference stencil for the diagonalized scheme is
59 c orthogonal, we do not have to perform the staged copying of faces,
60 c but can send all face information simultaneously to the neighboring
61 c cells in all directions
62 c---------------------------------------------------------------------
73 c---------------------------------------------------------------------
74 c fill the buffer to be sent to eastern neighbors (i-dir)
75 c---------------------------------------------------------------------
76 if (cell_coord(1,c) .ne. ncells) then
77 do k = 0, cell_size(3,c)-1
78 do j = 0, cell_size(2,c)-1
79 do i = cell_size(1,c)-2, cell_size(1,c)-1
80 out_buffer(ss(0)+p0) = u(i,j,k,m,c)
87 c---------------------------------------------------------------------
88 c fill the buffer to be sent to western neighbors
89 c---------------------------------------------------------------------
90 if (cell_coord(1,c) .ne. 1) then
91 do k = 0, cell_size(3,c)-1
92 do j = 0, cell_size(2,c)-1
94 out_buffer(ss(1)+p1) = u(i,j,k,m,c)
103 c---------------------------------------------------------------------
104 c fill the buffer to be sent to northern neighbors (j_dir)
105 c---------------------------------------------------------------------
106 if (cell_coord(2,c) .ne. ncells) then
107 do k = 0, cell_size(3,c)-1
108 do j = cell_size(2,c)-2, cell_size(2,c)-1
109 do i = 0, cell_size(1,c)-1
110 out_buffer(ss(2)+p2) = u(i,j,k,m,c)
117 c---------------------------------------------------------------------
118 c fill the buffer to be sent to southern neighbors
119 c---------------------------------------------------------------------
120 if (cell_coord(2,c).ne. 1) then
121 do k = 0, cell_size(3,c)-1
123 do i = 0, cell_size(1,c)-1
124 out_buffer(ss(3)+p3) = u(i,j,k,m,c)
131 c---------------------------------------------------------------------
132 c fill the buffer to be sent to top neighbors (k-dir)
133 c---------------------------------------------------------------------
134 if (cell_coord(3,c) .ne. ncells) then
135 do k = cell_size(3,c)-2, cell_size(3,c)-1
136 do j = 0, cell_size(2,c)-1
137 do i = 0, cell_size(1,c)-1
138 out_buffer(ss(4)+p4) = u(i,j,k,m,c)
145 c---------------------------------------------------------------------
146 c fill the buffer to be sent to bottom neighbors
147 c---------------------------------------------------------------------
148 if (cell_coord(3,c).ne. 1) then
150 do j = 0, cell_size(2,c)-1
151 do i = 0, cell_size(1,c)-1
152 out_buffer(ss(5)+p5) = u(i,j,k,m,c)
159 c---------------------------------------------------------------------
161 c---------------------------------------------------------------------
164 c---------------------------------------------------------------------
166 c---------------------------------------------------------------------
169 call mpi_irecv(in_buffer(sr(0)), b_size(0),
170 > dp_type, successor(1), WEST,
171 > comm_rhs, requests(0), error)
172 call mpi_irecv(in_buffer(sr(1)), b_size(1),
173 > dp_type, predecessor(1), EAST,
174 > comm_rhs, requests(1), error)
175 call mpi_irecv(in_buffer(sr(2)), b_size(2),
176 > dp_type, successor(2), SOUTH,
177 > comm_rhs, requests(2), error)
178 call mpi_irecv(in_buffer(sr(3)), b_size(3),
179 > dp_type, predecessor(2), NORTH,
180 > comm_rhs, requests(3), error)
181 call mpi_irecv(in_buffer(sr(4)), b_size(4),
182 > dp_type, successor(3), BOTTOM,
183 > comm_rhs, requests(4), error)
184 call mpi_irecv(in_buffer(sr(5)), b_size(5),
185 > dp_type, predecessor(3), TOP,
186 > comm_rhs, requests(5), error)
188 call mpi_isend(out_buffer(ss(0)), b_size(0),
189 > dp_type, successor(1), EAST,
190 > comm_rhs, requests(6), error)
191 call mpi_isend(out_buffer(ss(1)), b_size(1),
192 > dp_type, predecessor(1), WEST,
193 > comm_rhs, requests(7), error)
194 call mpi_isend(out_buffer(ss(2)), b_size(2),
195 > dp_type,successor(2), NORTH,
196 > comm_rhs, requests(8), error)
197 call mpi_isend(out_buffer(ss(3)), b_size(3),
198 > dp_type,predecessor(2), SOUTH,
199 > comm_rhs, requests(9), error)
200 call mpi_isend(out_buffer(ss(4)), b_size(4),
201 > dp_type,successor(3), TOP,
202 > comm_rhs, requests(10), error)
203 call mpi_isend(out_buffer(ss(5)), b_size(5),
204 > dp_type,predecessor(3), BOTTOM,
205 > comm_rhs,requests(11), error)
208 call mpi_waitall(12, requests, statuses, error)
210 c---------------------------------------------------------------------
211 c unpack the data that has just been received;
212 c---------------------------------------------------------------------
223 if (cell_coord(1,c) .ne. 1) then
224 do k = 0, cell_size(3,c)-1
225 do j = 0, cell_size(2,c)-1
227 u(i,j,k,m,c) = in_buffer(sr(1)+p0)
234 if (cell_coord(1,c) .ne. ncells) then
235 do k = 0, cell_size(3,c)-1
236 do j = 0, cell_size(2,c)-1
237 do i = cell_size(1,c), cell_size(1,c)+1
238 u(i,j,k,m,c) = in_buffer(sr(0)+p1)
245 if (cell_coord(2,c) .ne. 1) then
246 do k = 0, cell_size(3,c)-1
248 do i = 0, cell_size(1,c)-1
249 u(i,j,k,m,c) = in_buffer(sr(3)+p2)
257 if (cell_coord(2,c) .ne. ncells) then
258 do k = 0, cell_size(3,c)-1
259 do j = cell_size(2,c), cell_size(2,c)+1
260 do i = 0, cell_size(1,c)-1
261 u(i,j,k,m,c) = in_buffer(sr(2)+p3)
268 if (cell_coord(3,c) .ne. 1) then
270 do j = 0, cell_size(2,c)-1
271 do i = 0, cell_size(1,c)-1
272 u(i,j,k,m,c) = in_buffer(sr(5)+p4)
279 if (cell_coord(3,c) .ne. ncells) then
280 do k = cell_size(3,c), cell_size(3,c)+1
281 do j = 0, cell_size(2,c)-1
282 do i = 0, cell_size(1,c)-1
283 u(i,j,k,m,c) = in_buffer(sr(4)+p5)
290 c---------------------------------------------------------------------
292 c---------------------------------------------------------------------
295 c---------------------------------------------------------------------
297 c---------------------------------------------------------------------
300 c---------------------------------------------------------------------
301 c now that we have all the data, compute the rhs
302 c---------------------------------------------------------------------