Non-blocking MPI communication from every node to every other node fails

Question

I'm trying to implement a data transfer using Fortran 90 and MPI in which every node sends a specific buffer to every other node, i.e. for N nodes I have N-1 buffers to be sent, each one with a different content specific to the recipient node. This involves a double loop and non-blocking send/recv calls; here's the code:

program a2a
implicit none
include "mpif.h"
integer, parameter :: ILEN=4
integer :: nn,i,j,me,ierr
integer :: status(MPI_status_size)
integer, allocatable :: sndv(:),rcvv(:),ireq(:)
call MPI_init(ierr)
call MPI_comm_size(mpi_comm_world,nn,ierr)
nn=nn-1
call MPI_comm_rank(mpi_comm_world,me,ierr)
allocate(sndv(0:nn),rcvv(0:nn),ireq(0:nn))
do i=0,nn
   sndv(i)=10*me+i
   rcvv(i)=0
end do
do i=0,nn
   if (i == me) then
      do j=0,nn
         if (i == j) cycle
         call MPI_isend(sndv(j),ILEN,MPI_byte,j,1000+j,MPI_comm_world,ireq(j),ierr)
         write(*,*) 1000+j,'Send - #',me,' -> #',j,': ',sndv(j),ireq(j)
      end do
   else
      do j=0,nn
         if (i == j) cycle
         call MPI_irecv(rcvv(j),ILEN,MPI_byte,j,1000+j,MPI_comm_world,ireq(j),ierr)
         write(*,*) 1000+j,'Recv0 #',i,' -> #',j,': ',rcvv(j),ireq(j)
      end do
   end if
end do
do j=0,nn
   if (me == j) cycle
   call MPI_wait(ireq(j),status,ierr)
   write(*,*) 1000+j,'Recv1 #',me,' -> #',j,': ',rcvv(j),ireq(j)
end do
call MPI_barrier(MPI_comm_world,ierr)
do i=0,nn
   write(*,*) 'Recv2 #',i,' -> #',me,': ',rcvv(i)
end do
call MPI_finalize(ierr)
end program a2a

The expected result for a run with just two nodes is that node 0 sends "1" to node 1 and node 1 sends "10" to node 0. The actual result is that nothing seems to be sent, although there is no deadlock and the tags and request numbers seem to be correct. What is wrong here?

Thomas

Answer 1

Look at the MPI_irecv command, and what it should be:

MPI_irecv(rcvv(j),ILEN,MPI_byte,j,      1000+j,MPI_comm_world,ireq(j), ierr)
MPI_irecv(sendBuf, len,type,    source, tag,   comm,          request, ierr)

Specifically, you have set your source variable to be j. If you look at the MPI_isend command, however, the processor that is sending the information is processor i (the send only occurs if i == me). Change the source in your MPI_irecv command to i and it should work fine.

That said, this seems like a perfect use case for an MPI_Alltoall command, why don't you use that instead?

Answer 2

Turns out, the whole approach of the program was flawed, because for tests with more than 2 nodes, deadlocks occurred and/or buffers got mixed up. For the record, below is a new program that seems to do the job correctly.

@wolfPack88 concerning the suggestion to use MPI_Alltoallv: yes, in principle that would do it. However, in my actual problem, for which this is just a test, it is even more complicated in that the nodes involved in the whole task can be only a fairly small subset of all nodes of the run. In that case MPI_Alltoallv might be overkill and would presumably cause unnecessary communication. Still, pointing me to the mistake with the source finally opened my eyes to the root of the trouble, so thanks for that.

Here's the code:

program a2a
implicit none
include "mpif.h"
integer, parameter :: ILEN=4
integer :: nn,i,me,ierr
integer :: status(MPI_status_size)
integer, allocatable :: sndv(:),rcvv(:),ireq(:)
integer, external :: isend,irecv,mynode,numnodes
call MPI_init(ierr)
call MPI_comm_size(mpi_comm_world,nn,ierr)
nn=nn-1
call MPI_comm_rank(mpi_comm_world,me,ierr)
allocate(sndv(0:nn),rcvv(0:nn),ireq(0:nn))
do i=0,nn
   sndv(i)=10*me+i
   rcvv(i)=0
end do
do i=0,nn
   if (i == me) cycle
   call MPI_irecv(rcvv(i),ILEN,MPI_byte,i,1000*i+me,MPI_comm_world,ireq(i),ierr)
end do
do i=0,nn
   if (me == i) cycle
   call MPI_isend(sndv(i),ILEN,MPI_byte,i,1000*me+i,MPI_comm_world,ireq(i),ierr)
   write(*,*) 1000*me+i,'Send - #',me,' -> #',i,': ',sndv(i),ireq(i)
end do
do i=0,nn
   if (me == i) cycle
   call MPI_wait(ireq(i),status,ierr)
end do
call MPI_barrier(MPI_comm_world,ierr)
do i=0,nn
   if (i /= me) write(*,*) 'Recv2 #',i,' -> #',me,': ',rcvv(i)
end do
call MPI_finalize(ierr)
end program a2a