无法实施 MPI_Intercomm_create

Unable to implement MPI_Intercomm_create

我正在尝试在 2 个内部通信器之间用 Fortran 实现 MPI_intercomm,一个具有前 2 个进程,另一个具有其余进程。 我需要在新创建的通信器之间执行发送、接收操作。

代码:

program hello
include 'mpif.h'
integer tag,ierr,rank,numtasks,color,new_comm,inter1,inter2

tag = 22
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,1,tag,inter1,ierr)

!local_comm,local leader,peer_comm,remote leader,tag,new,ierr

else if(color .eq. 1) then      
call   MPI_INTERCOMM_CREATE(new_comm,1,MPI_COMM_WORLD,0,tag,inter2,ierr)
end if

select case (color)
case (0)
call    MPI_COMM_FREE(inter1)       
case(1)
 call mpi_comm_free(inter2) 

end select

call MPI_finalize(ierr)
end

代码编译没有任何问题。但是在 运行 时卡住了,有时会显示错误。

简短回答:问题来自 remote_leader.

的规范

长答案: 我假设您的拆分逻辑是您想要的:处理颜色 0 的 0 和 1 以及颜色 1 的世界其他部分,并且您将始终拥有 3 个以上的进程。 您必须选择:

  • 每种颜色的 local_leader。这是每个组的组长在本地通信器中的排名(new_comm 在你的例子中)。最简单的方法是选择等级为 0 的进程,因为这是本地通信器中的等级,所有进程都可以具有完全相同的值。所以我选择排名 0.

  • 每个颜色的remote_leader;这必须是内部通讯器另一端的领导者在 peer_comm(在您的情况下为 MPI_Comm_world)中的等级。这意味着,颜色为0的进程必须知道颜色为1的进程0对应于MPI_Comm_world中的进程;颜色 1 中的过程必须知道颜色 0 中的过程 0 对应于 MPI_Comm_world 中的什么过程。按照你的分裂逻辑和我选择local leader的逻辑,remote_leader必须对颜色0处理2,对颜色1处理0.

您应该可以使用修改后的代码行:

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)

else if(color .eq. 1) then
    if(rank==2) print*, ' 2 here'
    call   MPI_INTERCOMM_CREATE(new_comm,0,MPI_COMM_WORLD,0,tag,inter2,ierr)
end if

与您的代码最重要的区别是 remote_leader 是颜色 02。这就是问题的根源。 第二个区别是 local_leader 是颜色 1 的 0。这符合我选择 local_leader 的逻辑。这不是问题的根源,但是,如果您只有 1 颜色 1 过程,则可能是问题的根源。


更新

感谢 Hristo Iliev,我正在添加此更新。如果您的目标是使用颜色 1 的过程 1 作为 local_leader,那么颜色 0remote_leader 应该是 3,代码将是:

if (color .eq. 0) then
    if(rank==0) print*, ' 0 here'
    call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,3,tag,inter1,ierr)

else if(color .eq. 1) then
    if(rank==2) print*, ' 2 here'
    call   MPI_INTERCOMM_CREATE(new_comm,1,MPI_COMM_WORLD,0,tag,inter2,ierr)
end if

确保你检查了这个选项的所有内容,因为我没有特别注意检查它。还要确保你总是有更多的 1 颜色 1