+++ /dev/null
-c---------------------------------------------------------------------
-c---------------------------------------------------------------------
-
- subroutine copy_faces
-
-c---------------------------------------------------------------------
-c---------------------------------------------------------------------
-
-c---------------------------------------------------------------------
-c
-c This function copies the face values of a variable defined on a set
-c of cells to the overlap locations of the adjacent sets of cells.
-c Because a set of cells interfaces in each direction with exactly one
-c other set, we only need to fill six different buffers. We could try to
-c overlap communication with computation, by computing
-c some internal values while communicating boundary values, but this
-c adds so much overhead that it's not clearly useful.
-c---------------------------------------------------------------------
-
- include 'header.h'
- include 'mpinpb.h'
-
- integer i, j, k, c, m, requests(0:11), p0, p1,
- > p2, p3, p4, p5, b_size(0:5), ss(0:5),
- > sr(0:5), error, statuses(MPI_STATUS_SIZE, 0:11)
-
-c---------------------------------------------------------------------
-c exit immediately if there are no faces to be copied
-c---------------------------------------------------------------------
- if (no_nodes .eq. 1) then
- call compute_rhs
- return
- endif
-
- ss(0) = start_send_east
- ss(1) = start_send_west
- ss(2) = start_send_north
- ss(3) = start_send_south
- ss(4) = start_send_top
- ss(5) = start_send_bottom
-
- sr(0) = start_recv_east
- sr(1) = start_recv_west
- sr(2) = start_recv_north
- sr(3) = start_recv_south
- sr(4) = start_recv_top
- sr(5) = start_recv_bottom
-
- b_size(0) = east_size
- b_size(1) = west_size
- b_size(2) = north_size
- b_size(3) = south_size
- b_size(4) = top_size
- b_size(5) = bottom_size
-
-c---------------------------------------------------------------------
-c because the difference stencil for the diagonalized scheme is
-c orthogonal, we do not have to perform the staged copying of faces,
-c but can send all face information simultaneously to the neighboring
-c cells in all directions
-c---------------------------------------------------------------------
- p0 = 0
- p1 = 0
- p2 = 0
- p3 = 0
- p4 = 0
- p5 = 0
-
- do c = 1, ncells
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to eastern neighbors (i-dir)
-c---------------------------------------------------------------------
- if (cell_coord(1,c) .ne. ncells) then
- do k = 0, cell_size(3,c)-1
- do j = 0, cell_size(2,c)-1
- do i = cell_size(1,c)-2, cell_size(1,c)-1
- do m = 1, 5
- out_buffer(ss(0)+p0) = u(m,i,j,k,c)
- p0 = p0 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to western neighbors
-c---------------------------------------------------------------------
- if (cell_coord(1,c) .ne. 1) then
- do k = 0, cell_size(3,c)-1
- do j = 0, cell_size(2,c)-1
- do i = 0, 1
- do m = 1, 5
- out_buffer(ss(1)+p1) = u(m,i,j,k,c)
- p1 = p1 + 1
- end do
- end do
- end do
- end do
-
- endif
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to northern neighbors (j_dir)
-c---------------------------------------------------------------------
- if (cell_coord(2,c) .ne. ncells) then
- do k = 0, cell_size(3,c)-1
- do j = cell_size(2,c)-2, cell_size(2,c)-1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- out_buffer(ss(2)+p2) = u(m,i,j,k,c)
- p2 = p2 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to southern neighbors
-c---------------------------------------------------------------------
- if (cell_coord(2,c).ne. 1) then
- do k = 0, cell_size(3,c)-1
- do j = 0, 1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- out_buffer(ss(3)+p3) = u(m,i,j,k,c)
- p3 = p3 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to top neighbors (k-dir)
-c---------------------------------------------------------------------
- if (cell_coord(3,c) .ne. ncells) then
- do k = cell_size(3,c)-2, cell_size(3,c)-1
- do j = 0, cell_size(2,c)-1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- out_buffer(ss(4)+p4) = u(m,i,j,k,c)
- p4 = p4 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c fill the buffer to be sent to bottom neighbors
-c---------------------------------------------------------------------
- if (cell_coord(3,c).ne. 1) then
- do k=0, 1
- do j = 0, cell_size(2,c)-1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- out_buffer(ss(5)+p5) = u(m,i,j,k,c)
- p5 = p5 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c cell loop
-c---------------------------------------------------------------------
- end do
-
- call mpi_irecv(in_buffer(sr(0)), b_size(0),
- > dp_type, successor(1), WEST,
- > comm_rhs, requests(0), error)
- call mpi_irecv(in_buffer(sr(1)), b_size(1),
- > dp_type, predecessor(1), EAST,
- > comm_rhs, requests(1), error)
- call mpi_irecv(in_buffer(sr(2)), b_size(2),
- > dp_type, successor(2), SOUTH,
- > comm_rhs, requests(2), error)
- call mpi_irecv(in_buffer(sr(3)), b_size(3),
- > dp_type, predecessor(2), NORTH,
- > comm_rhs, requests(3), error)
- call mpi_irecv(in_buffer(sr(4)), b_size(4),
- > dp_type, successor(3), BOTTOM,
- > comm_rhs, requests(4), error)
- call mpi_irecv(in_buffer(sr(5)), b_size(5),
- > dp_type, predecessor(3), TOP,
- > comm_rhs, requests(5), error)
-
- call mpi_isend(out_buffer(ss(0)), b_size(0),
- > dp_type, successor(1), EAST,
- > comm_rhs, requests(6), error)
- call mpi_isend(out_buffer(ss(1)), b_size(1),
- > dp_type, predecessor(1), WEST,
- > comm_rhs, requests(7), error)
- call mpi_isend(out_buffer(ss(2)), b_size(2),
- > dp_type,successor(2), NORTH,
- > comm_rhs, requests(8), error)
- call mpi_isend(out_buffer(ss(3)), b_size(3),
- > dp_type,predecessor(2), SOUTH,
- > comm_rhs, requests(9), error)
- call mpi_isend(out_buffer(ss(4)), b_size(4),
- > dp_type,successor(3), TOP,
- > comm_rhs, requests(10), error)
- call mpi_isend(out_buffer(ss(5)), b_size(5),
- > dp_type,predecessor(3), BOTTOM,
- > comm_rhs,requests(11), error)
-
-
- call mpi_waitall(12, requests, statuses, error)
-
-c---------------------------------------------------------------------
-c unpack the data that has just been received;
-c---------------------------------------------------------------------
- p0 = 0
- p1 = 0
- p2 = 0
- p3 = 0
- p4 = 0
- p5 = 0
-
- do c = 1, ncells
-
- if (cell_coord(1,c) .ne. 1) then
- do k = 0, cell_size(3,c)-1
- do j = 0, cell_size(2,c)-1
- do i = -2, -1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(1)+p0)
- p0 = p0 + 1
- end do
- end do
- end do
- end do
- endif
-
- if (cell_coord(1,c) .ne. ncells) then
- do k = 0, cell_size(3,c)-1
- do j = 0, cell_size(2,c)-1
- do i = cell_size(1,c), cell_size(1,c)+1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(0)+p1)
- p1 = p1 + 1
- end do
- end do
- end do
- end do
- end if
-
- if (cell_coord(2,c) .ne. 1) then
- do k = 0, cell_size(3,c)-1
- do j = -2, -1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(3)+p2)
- p2 = p2 + 1
- end do
- end do
- end do
- end do
-
- endif
-
- if (cell_coord(2,c) .ne. ncells) then
- do k = 0, cell_size(3,c)-1
- do j = cell_size(2,c), cell_size(2,c)+1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(2)+p3)
- p3 = p3 + 1
- end do
- end do
- end do
- end do
- endif
-
- if (cell_coord(3,c) .ne. 1) then
- do k = -2, -1
- do j = 0, cell_size(2,c)-1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(5)+p4)
- p4 = p4 + 1
- end do
- end do
- end do
- end do
- endif
-
- if (cell_coord(3,c) .ne. ncells) then
- do k = cell_size(3,c), cell_size(3,c)+1
- do j = 0, cell_size(2,c)-1
- do i = 0, cell_size(1,c)-1
- do m = 1, 5
- u(m,i,j,k,c) = in_buffer(sr(4)+p5)
- p5 = p5 + 1
- end do
- end do
- end do
- end do
- endif
-
-c---------------------------------------------------------------------
-c cells loop
-c---------------------------------------------------------------------
- end do
-
-c---------------------------------------------------------------------
-c do the rest of the rhs that uses the copied face values
-c---------------------------------------------------------------------
- call compute_rhs
-
- return
- end
