从每个节点到每个其他节点的非阻塞 MPI 通信失败

Question

我正在尝试使用 Fortran 90 和 MPI 实现数据传输，其中每个节点向每个其他节点发送一个特定的缓冲区，即对于 N 个节点，我有 N-1 个要发送的缓冲区，每个缓冲区都有不同的内容特定于接收节点。这涉及双循环和非阻塞发送/接收调用；这是代码：

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

只有两个节点的运行的预期结果是节点 0 向节点 1 发送“1”，节点 1 向节点 0 发送“10”。实际结果是似乎什么都没有发送，虽然没有死锁，标签和请求编号似乎是正确的。这里有什么问题？

托马斯

Answer 1

查看MPI_irecv 命令，它应该是什么：

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)

具体来说，您已将source 变量设置为j。但是，如果您查看MPI_isend 命令，发送信息的处理器是处理器i（仅在i == me 时才会发生发送）。将MPI_irecv 命令中的source 更改为i，它应该可以正常工作。

也就是说，这似乎是 MPI_Alltoall 命令的完美用例，你为什么不使用它呢？

Answer 2

事实证明，程序的整个方法存在缺陷，因为对于超过 2 个节点的测试，会发生死锁和/或缓冲区混淆。作为记录，下面是一个似乎可以正确完成工作的新程序。

@wolfPack88 关于使用 MPI_Alltoallv 的建议：是的，原则上会这样做。然而，在我的实际问题中，这只是一个测试，更复杂的是，整个任务中涉及的节点可能只是运行的所有节点的一个相当小的子集。在这种情况下， MPI_Alltoallv 可能会过度杀伤力，并且可能会导致不必要的通信。尽管如此，向我指出源的错误终于让我看到了问题的根源，所以谢谢你。

代码如下：

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