X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/d64b23f264fa43f785c688073c66297a7c475c40..d8983d99631ddba747941cadb391ce80243a5529:/examples/smpi/NAS/BT/copy_faces.f diff --git a/examples/smpi/NAS/BT/copy_faces.f b/examples/smpi/NAS/BT/copy_faces.f deleted file mode 100644 index 14b82caf83..0000000000 --- a/examples/smpi/NAS/BT/copy_faces.f +++ /dev/null @@ -1,316 +0,0 @@ -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