Handle 1D arrays for MPI_Ssend and Add Test for MPI_WaitAll

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

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