按照我之前的问题:Unable to implement MPI_Intercomm_create
MPI_INTERCOMM_CREATE的问题已经解决。但是当我尝试在颜色0的进程0(全局秩= 0)和颜色1的进程0(即全局秩= 2)之间实现基本的发送接收操作时,代码在打印接收缓冲区后挂起。 代码:
program hello
include 'mpif.h'
implicit none
integer tag,ierr,rank,numtasks,color,new_comm,inter1,inter2
integer sendbuf,recvbuf,tag,stat(MPI_STATUS_SIZE)
tag = 22
sendbuf = 222
call MPI_Init(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr)
if (rank < 2) then
color = 0
else
color = 1
end if
call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr)
if (color .eq. 0) then
if (rank == 0) print*,' 0 here'
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,2,tag,inter1,ierr)
call mpi_send(sendbuf,1,MPI_INT,2,tag,inter1,ierr)
!local_comm,local leader,peer_comm,remote leader,tag,new,ierr
else if(color .eq. 1) then
if(rank ==2) print*,' 2 here'
call MPI_INTERCOMM_CREATE(new_comm,2,MPI_COMM_WORLD,0,tag,inter2,ierr)
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr)
print*,recvbuf
end if
end
答案 0 :(得分:0)
大多数用户并未充分理解与相互通信的通信,并且示例并不像其他MPI操作的示例那么多。您可以按照this link找到一个很好的解释。
现在,有两件事需要记住:
1)内部通信器中的通信总是从一个组到另一个组。发送时,目的地的等级是其在远程组通信器中的本地等级。在接收时,发送者的等级是其在远程群组通信器中的本地等级。
2)点对点通信(MPI_send和MPI_recv系列)在一个发送者和一个接收者之间。在您的情况下,颜色为0
的所有人都在发送,并且每个人都在接收颜色1
,但是,如果我了解您的问题,则需要处理0
颜色0
将某些内容发送到彩色0
的流程1
。
发送代码应该是这样的:
call MPI_COMM_RANK(inter1,irank,ierr)
if(irank==0)then
call mpi_send(sendbuf,1,MPI_INT,0,tag,inter1,ierr)
end if
接收代码应如下所示:
call MPI_COMM_RANK(inter2,irank,ierr)
if(irank==0)then
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr)
print*,'rec buff = ', recvbuf
end if
在示例代码中,有一个新变量irank
,我用它来查询inter-communicator中每个进程的排名;这是他当地传播者的过程等级。因此,您将有两个排名0
的流程,每个群组一个,依此类推。
重要的是要强调你帖子的其他评论员所说的:在现代建立程序时,使用像use mpi
而不是include 'mpif.h'
这样的现代结构,请参阅弗拉基米尔的评论。另一个建议从你之前的问题来看,你在这两种情况下都使用等级0
作为远程领导者。如果我将这两个想法结合起来,您的程序可能如下所示:
program hello
use mpi !instead of include 'mpif.h'
implicit none
integer :: tag,ierr,rank,numtasks,color,new_comm,inter1,inter2
integer :: sendbuf,recvbuf,stat(MPI_STATUS_SIZE)
integer :: irank
!
tag = 22
sendbuf = 222
!
call MPI_Init(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr)
!
if (rank < 2) then
color = 0
else
color = 1
end if
!
call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr)
!
if (color .eq. 0) then
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,2,tag,inter1,ierr)
!
call MPI_COMM_RANK(inter1,irank,ierr)
if(irank==0)then
call mpi_send(sendbuf,1,MPI_INT,0,tag,inter1,ierr)
end if
!
else if(color .eq. 1) then
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_COMM_WORLD,0,tag,inter2,ierr)
call MPI_COMM_RANK(inter2,irank,ierr)
if(irank==0)then
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr)
if(ierr/=MPI_SUCCESS)print*,'Error in rec '
print*,'rec buff = ', recvbuf
end if
end if
!
call MPI_finalize(ierr)
end program h