无法实现 MPI_Intercomm_create

Question

我正在尝试在 Fortran 中在 2 个内部通信器之间实现一个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

代码编译没有任何问题。但运行时卡住，有时会报错。

Answer 1

简短回答：问题来自remote_leader 的规范。

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

• 每种颜色的local_leader。这是每个组的领导者在本地通信器中的排名（在您的情况下为new_comm）。不头痛的方法是选择rank为0的进程，因为这是本地通信器中的rank，所有进程都可以有完全相同的值。所以我选择排名 0。

• 每种颜色的remote_leader；这必须是内部通信器另一端领导者的peer_comm（在您的情况下为MPI_Comm_world）中的等级。这意味着，颜色0的进程必须知道颜色1中的0对应于MPI_Comm_world中的进程；并且颜色 1 的处理必须知道颜色0 中的处理0 对应于MPI_Comm_world。根据你的拆分逻辑和我选择本地leader的逻辑，remote_leader必须处理2为颜色0，处理0为颜色1。

你应该很好地使用这些修改过的代码行：

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 是2 用于颜色0。这就是问题的根源。 第二个区别是local_leader对于颜色1是0。这符合我选择local_leader的逻辑。这不是问题的根源，但是，如果您只有颜色为1 的1 进程，则可能是这样。

---

更新

感谢 Hristo Iliev，我正在添加此更新。如果您的目标是使用颜色 1 的进程 1 作为 local_leader，那么颜色 0 的 remote_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。