为什么在 MPI_IRecv 之后所有进程等级都变为 0?

问题描述

我正在实现一个非常简单的非阻塞发送接收。但是,我注意到在 MPI_Irecv() 之后,所有进程等级都变为 0。如下面的代码所示,我尝试在 MPI_Irecv() 之前打印等级,等级仍然正确。 发生了什么改变了这些排名?以及如何修复?

program send_async
  implicit none
  include 'mpif.h'

  integer :: process_rank,cluster_size,ierror,request,status
  integer,parameter :: MASTER_RANK = 0,ARR_SIZE = 10
  integer,allocatable :: arr(:),arr_p(:)
  integer :: i
  integer :: arr_p_size
  integer :: receiver_rank,start_idx,end_idx

  call MPI_INIT(ierror)
  call MPI_COMM_SIZE(MPI_COMM_WORLD,ierror)
  call MPI_COMM_RANK(MPI_COMM_WORLD,process_rank,ierror)

  ! Initiate the whole array only in the master process
  if (MASTER_RANK == process_rank) then
    allocate(arr(ARR_SIZE))
    arr = [(i,i=1,ARR_SIZE)]
  end if

  ! Initiate partial array in each process (even the master)
  arr_p_size = ARR_SIZE/cluster_size
  allocate(arr_p(arr_p_size))
  ! Master send partial array even to itself
  if (MASTER_RANK == process_rank) then
    do receiver_rank = 0,cluster_size-1
      start_idx = receiver_rank*arr_p_size + 1
      end_idx = (receiver_rank+1)*arr_p_size
      call MPI_ISEND(arr(start_idx:end_idx),arr_p_size,MPI_INT,receiver_rank,&
        1,MPI_COMM_WORLD,ierror)
    end do
  end if

  print *,"Hi,I'm process of rank:",process_rank

  call MPI_IRECV(arr_p(1:arr_p_size),MASTER_RANK,1,&
    MPI_COMM_WORLD,ierror)
  call MPI_WAIT(request,status,ierror)
  print *,"Hi I'm rank:","I have arr_p=",arr_p(:)

  call MPI_FINALIZE(ierror)
end program send_async

我使用 OpenMPI 4.0.3,并使用以下命令编译代码

mpif90 -g -ffpe-trap=zero,invalid,overflow,underflow -Wall -Werror send_async.f90 -o send_async

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)