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发送＆＃34; 1＆＃34;节点1和节点1发送＆＃34; 10＆＃34;实际结果是，似乎没有发送任何内容，尽管没有死锁，标签和请求数似乎是正确的。这有什么不对？

托马斯

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时才会发送）。将source命令中的MPI_irecv更改为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

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

2 个答案: