1 c---------------------------------------------------------------------
2 c---------------------------------------------------------------------
6 c---------------------------------------------------------------------
7 c---------------------------------------------------------------------
9 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
35 ss(0) = start_send_east
36 ss(1) = start_send_west
37 ss(2) = start_send_north
38 ss(3) = start_send_south
39 ss(4) = start_send_top
40 ss(5) = start_send_bottom
42 sr(0) = start_recv_east
43 sr(1) = start_recv_west
44 sr(2) = start_recv_north
45 sr(3) = start_recv_south
46 sr(4) = start_recv_top
47 sr(5) = start_recv_bottom
51 b_size(2) = north_size
52 b_size(3) = south_size
54 b_size(5) = bottom_size
56 c---------------------------------------------------------------------
57 c because the difference stencil for the diagonalized scheme is
58 c orthogonal, we do not have to perform the staged copying of faces,
59 c but can send all face information simultaneously to the neighboring
60 c cells in all directions
61 c---------------------------------------------------------------------
71 c---------------------------------------------------------------------
72 c fill the buffer to be sent to eastern neighbors (i-dir)
73 c---------------------------------------------------------------------
74 if (cell_coord(1,c) .ne. ncells) then
75 do k = 0, cell_size(3,c)-1
76 do j = 0, cell_size(2,c)-1
77 do i = cell_size(1,c)-2, cell_size(1,c)-1
79 out_buffer(ss(0)+p0) = u(m,i,j,k,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
95 out_buffer(ss(1)+p1) = u(m,i,j,k,c)
104 c---------------------------------------------------------------------
105 c fill the buffer to be sent to northern neighbors (j_dir)
106 c---------------------------------------------------------------------
107 if (cell_coord(2,c) .ne. ncells) then
108 do k = 0, cell_size(3,c)-1
109 do j = cell_size(2,c)-2, cell_size(2,c)-1
110 do i = 0, cell_size(1,c)-1
112 out_buffer(ss(2)+p2) = u(m,i,j,k,c)
120 c---------------------------------------------------------------------
121 c fill the buffer to be sent to southern neighbors
122 c---------------------------------------------------------------------
123 if (cell_coord(2,c).ne. 1) then
124 do k = 0, cell_size(3,c)-1
126 do i = 0, cell_size(1,c)-1
128 out_buffer(ss(3)+p3) = u(m,i,j,k,c)
136 c---------------------------------------------------------------------
137 c fill the buffer to be sent to top neighbors (k-dir)
138 c---------------------------------------------------------------------
139 if (cell_coord(3,c) .ne. ncells) then
140 do k = cell_size(3,c)-2, cell_size(3,c)-1
141 do j = 0, cell_size(2,c)-1
142 do i = 0, cell_size(1,c)-1
144 out_buffer(ss(4)+p4) = u(m,i,j,k,c)
152 c---------------------------------------------------------------------
153 c fill the buffer to be sent to bottom neighbors
154 c---------------------------------------------------------------------
155 if (cell_coord(3,c).ne. 1) then
157 do j = 0, cell_size(2,c)-1
158 do i = 0, cell_size(1,c)-1
160 out_buffer(ss(5)+p5) = u(m,i,j,k,c)
168 c---------------------------------------------------------------------
170 c---------------------------------------------------------------------
173 call mpi_irecv(in_buffer(sr(0)), b_size(0),
174 > dp_type, successor(1), WEST,
175 > comm_rhs, requests(0), error)
176 call mpi_irecv(in_buffer(sr(1)), b_size(1),
177 > dp_type, predecessor(1), EAST,
178 > comm_rhs, requests(1), error)
179 call mpi_irecv(in_buffer(sr(2)), b_size(2),
180 > dp_type, successor(2), SOUTH,
181 > comm_rhs, requests(2), error)
182 call mpi_irecv(in_buffer(sr(3)), b_size(3),
183 > dp_type, predecessor(2), NORTH,
184 > comm_rhs, requests(3), error)
185 call mpi_irecv(in_buffer(sr(4)), b_size(4),
186 > dp_type, successor(3), BOTTOM,
187 > comm_rhs, requests(4), error)
188 call mpi_irecv(in_buffer(sr(5)), b_size(5),
189 > dp_type, predecessor(3), TOP,
190 > comm_rhs, requests(5), error)
192 call mpi_isend(out_buffer(ss(0)), b_size(0),
193 > dp_type, successor(1), EAST,
194 > comm_rhs, requests(6), error)
195 call mpi_isend(out_buffer(ss(1)), b_size(1),
196 > dp_type, predecessor(1), WEST,
197 > comm_rhs, requests(7), error)
198 call mpi_isend(out_buffer(ss(2)), b_size(2),
199 > dp_type,successor(2), NORTH,
200 > comm_rhs, requests(8), error)
201 call mpi_isend(out_buffer(ss(3)), b_size(3),
202 > dp_type,predecessor(2), SOUTH,
203 > comm_rhs, requests(9), error)
204 call mpi_isend(out_buffer(ss(4)), b_size(4),
205 > dp_type,successor(3), TOP,
206 > comm_rhs, requests(10), error)
207 call mpi_isend(out_buffer(ss(5)), b_size(5),
208 > dp_type,predecessor(3), BOTTOM,
209 > comm_rhs,requests(11), error)
212 call mpi_waitall(12, requests, statuses, error)
214 c---------------------------------------------------------------------
215 c unpack the data that has just been received;
216 c---------------------------------------------------------------------
226 if (cell_coord(1,c) .ne. 1) then
227 do k = 0, cell_size(3,c)-1
228 do j = 0, cell_size(2,c)-1
231 u(m,i,j,k,c) = in_buffer(sr(1)+p0)
239 if (cell_coord(1,c) .ne. ncells) then
240 do k = 0, cell_size(3,c)-1
241 do j = 0, cell_size(2,c)-1
242 do i = cell_size(1,c), cell_size(1,c)+1
244 u(m,i,j,k,c) = in_buffer(sr(0)+p1)
252 if (cell_coord(2,c) .ne. 1) then
253 do k = 0, cell_size(3,c)-1
255 do i = 0, cell_size(1,c)-1
257 u(m,i,j,k,c) = in_buffer(sr(3)+p2)
266 if (cell_coord(2,c) .ne. ncells) then
267 do k = 0, cell_size(3,c)-1
268 do j = cell_size(2,c), cell_size(2,c)+1
269 do i = 0, cell_size(1,c)-1
271 u(m,i,j,k,c) = in_buffer(sr(2)+p3)
279 if (cell_coord(3,c) .ne. 1) then
281 do j = 0, cell_size(2,c)-1
282 do i = 0, cell_size(1,c)-1
284 u(m,i,j,k,c) = in_buffer(sr(5)+p4)
292 if (cell_coord(3,c) .ne. ncells) then
293 do k = cell_size(3,c), cell_size(3,c)+1
294 do j = 0, cell_size(2,c)-1
295 do i = 0, cell_size(1,c)-1
297 u(m,i,j,k,c) = in_buffer(sr(4)+p5)
305 c---------------------------------------------------------------------
307 c---------------------------------------------------------------------
310 c---------------------------------------------------------------------
311 c do the rest of the rhs that uses the copied face values
312 c---------------------------------------------------------------------