diff --git a/src/mpi.f90 b/src/mpi.f90 index a341f1d..4d571b8 100644 --- a/src/mpi.f90 +++ b/src/mpi.f90 @@ -91,7 +91,8 @@ module mpi end interface interface MPI_Ssend - module procedure MPI_Ssend_proc + module procedure MPI_Ssend_2D_proc + module procedure MPI_Ssend_1D_proc end interface interface MPI_Cart_create @@ -597,7 +598,7 @@ subroutine MPI_Waitall_proc(count, array_of_requests, array_of_statuses, ierror) call c_mpi_waitall(count, array_of_requests, array_of_statuses, ierror) end subroutine - subroutine MPI_Ssend_proc(buf, count, datatype, dest, tag, comm, ierror) + subroutine MPI_Ssend_1D_proc(buf, count, datatype, dest, tag, comm, ierror) use iso_c_binding, only: c_int, c_ptr use mpi_c_bindings, only: c_mpi_ssend, c_mpi_datatype_f2c, c_mpi_comm_f2c real(8), dimension(*), intent(in) :: buf @@ -613,6 +614,22 @@ subroutine MPI_Ssend_proc(buf, count, datatype, dest, tag, comm, ierror) local_ierr = c_mpi_ssend(buf, count, c_datatype, dest, tag, c_comm) end subroutine + subroutine MPI_Ssend_2D_proc(buf, count, datatype, dest, tag, comm, ierror) + use iso_c_binding, only: c_int, c_ptr + use mpi_c_bindings, only: c_mpi_ssend, c_mpi_datatype_f2c, c_mpi_comm_f2c + real(8), dimension(:,:), intent(in) :: buf + integer, intent(in) :: count, dest, tag + integer, intent(in) :: datatype + integer, intent(in) :: comm + integer, optional, intent(out) :: ierror + type(c_ptr) :: c_datatype, c_comm + integer :: local_ierr + + c_datatype = c_mpi_datatype_f2c(datatype) + c_comm = c_mpi_comm_f2c(comm) + local_ierr = c_mpi_ssend(buf, count, c_datatype, dest, tag, c_comm) + end subroutine + subroutine MPI_Cart_create_proc(comm_old, ndims, dims, periods, reorder, comm_cart, ierror) use iso_c_binding, only: c_int, c_ptr use mpi_c_bindings, only: c_mpi_cart_create, c_mpi_comm_f2c, c_mpi_comm_c2f diff --git a/tests/waitall_1.f90 b/tests/waitall_1.f90 new file mode 100644 index 0000000..c259c85 --- /dev/null +++ b/tests/waitall_1.f90 @@ -0,0 +1,46 @@ +program test_waitall + use mpi + implicit none + + integer :: ierr, rank, size, tag + integer, parameter :: num_reqs = 2 + integer, dimension(num_reqs) :: reqs + ! For statuses, we need an array of size num_reqs * MPI_STATUS_SIZE. + integer, dimension(num_reqs*MPI_STATUS_SIZE) :: statuses + real(8), dimension(3,3) :: buf1, buf2 + integer :: i + + tag = 100 + + call MPI_Init(ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) + call MPI_Comm_size(MPI_COMM_WORLD, size, ierr) + + if (size < 2) then + print *, "This test requires at least 2 MPI processes." + ! call MPI_Finalize(ierr) ! Remove stop and finalize + ! stop 1 + else + if (rank == 0) then + ! Rank 0 sends two messages using MPI_Ssend. + buf1 = reshape([(i, i=1, 9)], shape=(/3,3/)) + buf2 = reshape([(i, i=1, 9)], shape=(/3,3/)) + call MPI_Ssend(buf1, 10, MPI_REAL8, 1, tag, MPI_COMM_WORLD, ierr) + call MPI_Ssend(buf2, 10, MPI_REAL8, 1, tag, MPI_COMM_WORLD, ierr) + print *, "Rank 0 sent two messages." + else if (rank == 1) then + ! Rank 1 posts two nonblocking receives. + call MPI_Irecv(buf1, 10, MPI_REAL8, 0, tag, MPI_COMM_WORLD, reqs(1), ierr) + call MPI_Irecv(buf2, 10, MPI_REAL8, 0, tag, MPI_COMM_WORLD, reqs(2), ierr) + + ! Wait on both requests. + call MPI_Waitall(num_reqs, reqs, statuses, ierr) + + print *, "Rank 1 received buf1 =", buf1 + print *, "Rank 1 received buf2 =", buf2 + end if + end if + + call MPI_Finalize(ierr) + +end program test_waitall \ No newline at end of file