MPI_Bcast 非根节点未接收到所有数据答案

【问题标题】：MPI_Bcast non-root nodes not receiving all dataMPI_Bcast 非根节点未接收到所有数据
【发布时间】：2021-06-17 06:46:01
【问题描述】：

所以，我目前正在编写一个使用 CGNS 和 Amrex 的自适应网格细化 (AMR) 进行输出的小规模代码。这一切都是用 Fortran 95 完成的，尽管 CGNS 是带有 Fortran 接口的 C，而 Amrex 是带有 Fortran 接口的 C++（这些不在示例代码中）。我正在使用 OpenMPI 1.10.7。

这最终会变成完整的 CFD 代码，但我想在放入更大的代码之前对其进行小规模测试以解决错误。下面的程序似乎每次都能运行，但它原本是一个子程序，没有。

我遇到了一个问题，不是每个进程都接收到来自 MPI_Bcast 的所有数据……有时。我可以连续两次在同一代码上执行，有时会被炸毁（代码中其他地方的CGNS的段错误，有时它可以工作。据我所知，当不是来自MPI_Bcast的所有数据时，程序会炸毁及时收到以在其他地方开始工作。尽管有 MPI_wait 和 MPI_barrier，但子例程底部的写入将在 lvl=1 上为所有数组的最后六个索引吐出垃圾。将信息打印到屏幕似乎有帮助，但是更多处理器似乎会降低代码工作的可能性。

我目前将它作为带有 MPI_wait 的 MPI_ibcast，但之后我也尝试过带有 MPI_barriers 的 MPI_Bcast。将通信器从 Amrex 定义的通信器更改为 MPI_COMM_WORLD 并没有帮助。

...

program so_bcast
!
!
!
!
use mpi
implicit none
  integer :: lvl,i,a,b,c,ier,state(MPI_STATUS_SIZE),d
  integer :: n_elems,req,counter,tag,flavor
  integer :: stat(MPI_STATUS_SIZE)
  integer :: self,nprocs

type :: box_zones
  integer,allocatable :: lower(:,:),higher(:,:),little_zones(:)
  double precision,allocatable :: lo_corner(:,:),hi_corner(:,:)
  integer :: big_zones
  integer,allocatable :: zone_start(:),zone_end(:)
end type

type(box_zones),allocatable :: zone_storage(:)

call MPI_INIT(ier)
call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ier)
call MPI_COMM_RANK(MPI_COMM_WORLD,self,ier)

lvl = 1
! Allocate everything, this is done elsewhere in the actual code, but done here
! for simplification reasons
allocate(zone_storage(0:lvl))
zone_storage(0)%big_zones = 4
zone_storage(1)%big_zones = 20
do i = 0,lvl
  allocate(zone_storage(i)%lower(3,zone_storage(i)%big_zones))
  allocate(zone_storage(i)%higher(3,zone_storage(i)%big_zones))
  allocate(zone_storage(i)%lo_corner(3,zone_storage(i)%big_zones))
  allocate(zone_storage(i)%hi_corner(3,zone_storage(i)%big_zones))
  zone_storage(i)%lower = self
  zone_storage(i)%higher = self*2+1
  zone_storage(i)%lo_corner = self*1.0D0
  zone_storage(i)%hi_corner = self*1.0D0+1.0D0

  allocate(zone_storage(i)%zone_start(0:nprocs-1))
  allocate(zone_storage(i)%zone_end(0:nprocs-1))
  zone_storage(i)%zone_start(self) = zone_storage(i)%big_zones/nprocs*self+1
  zone_storage(i)%zone_end(self) = zone_storage(i)%zone_start(self)+zone_storage(i)%big_zones/nprocs-1
  if (zone_storage(i)%zone_end(self)>zone_storage(i)%big_zones) zone_storage(i)%zone_end(self) = zone_storage(i)%big_zones
end do

do i = 0,lvl
write(*,*) 'lower check 0',self,'lower',zone_storage(i)%lower
write(*,*) 'higher check 0',self,'high',zone_storage(i)%higher
write(*,*) 'lo_corner check 0',self,'lo_corner',zone_storage(i)%lo_corner
write(*,*) 'hi_corner check 0',self,'hi_corner',zone_storage(i)%hi_corner
write(*,*) 'big_zones check 0',self,'big_zones',zone_storage(i)%big_zones
write(*,*) 'zone start/end 0',self,'lvl',i,zone_storage(i)%zone_start,zone_storage(i)%zone_end
end do

!
! Agglomerate the appropriate data to processor 0 using non-blocking receives
! and blocking sends
!
do i = 0,lvl
  do a = 0,nprocs-1
    call mpi_bcast(zone_storage(i)%zone_start(a),1,&
      MPI_INT,a,MPI_COMM_WORLD,ier)
    call mpi_bcast(zone_storage(i)%zone_end(a),1,&
      MPI_INT,a,MPI_COMM_WORLD,ier)
  end do
end do

call MPI_BARRIER(MPI_COMM_WORLD,ier)

counter = 0
do i = 0,lvl
  n_elems = 3*zone_storage(i)%big_zones
  write(*,*) 'number of elements',n_elems
  if (self == 0) then
    do a = 1,nprocs-1
      do c = zone_storage(i)%zone_start(a),zone_storage(i)%zone_end(a)
        tag = c*100000+a*1000+1!+d*10
        call mpi_irecv(zone_storage(i)%lower(1:3,c),3,MPI_INT,a,&
          tag,MPI_COMM_WORLD,req,ier)
        tag = tag + 1
        call mpi_irecv(zone_storage(i)%higher(1:3,c),3,MPI_INT,a,&
          tag,MPI_COMM_WORLD,req,ier)
        tag = tag +1
        call mpi_irecv(zone_storage(i)%lo_corner(1:3,c),3,MPI_DOUBLE_PRECISION,a,&
          tag,MPI_COMM_WORLD,req,ier)
        tag = tag +1
        call mpi_irecv(zone_storage(i)%hi_corner(1:3,c),3,MPI_DOUBLE_PRECISION,a,&
          tag,MPI_COMM_WORLD,req,ier)
      end do
    end do
  else
    do b = zone_storage(i)%zone_start(self),zone_storage(i)%zone_end(self)
      tag = b*100000+self*1000+1!+d*10
      call mpi_send(zone_storage(i)%lower(1:3,b),3,MPI_INT,0,&
        tag,MPI_COMM_WORLD,ier)
      tag = tag + 1
      call mpi_send(zone_storage(i)%higher(1:3,b),3,MPI_INT,0,&
        tag,MPI_COMM_WORLD,ier)
      tag = tag + 1
      call mpi_send(zone_storage(i)%lo_corner(1:3,b),3,MPI_DOUBLE_PRECISION,0,&
        tag,MPI_COMM_WORLD,ier)
      tag = tag +1
      call mpi_send(zone_storage(i)%hi_corner(1:3,b),3,MPI_DOUBLE_PRECISION,0,&
        tag,MPI_COMM_WORLD,ier)
    end do
  end if
end do
write(*,*) 'spack'
!
call mpi_barrier(MPI_COMM_WORLD,ier)

do i = 0,lvl
write(*,*) 'lower check 1',self,'lower',zone_storage(i)%lower
write(*,*) 'higher check 1',self,'high',zone_storage(i)%higher
write(*,*) 'lo_corner check 1',self,'lo_corner',zone_storage(i)%lo_corner
write(*,*) 'hi_corner check 1',self,'hi_corner',zone_storage(i)%hi_corner
write(*,*) 'big_zones check 1',self,'big_zones',zone_storage(i)%big_zones
write(*,*) 'zone start/end 1',self,'lvl',i,zone_storage(i)%zone_start,zone_storage(i)%zone_end
end do
!
! Send all the data out to all the processors
!
do i = 0,lvl
  n_elems = 3*zone_storage(i)%big_zones

  req = 1
  call mpi_ibcast(zone_storage(i)%lower,n_elems,MPI_INT,&
    0,MPI_COMM_WORLD,req,ier)
  call mpi_wait(req,stat,ier)
  write(*,*) 'spiffy'
  req = 2
  call mpi_ibcast(zone_storage(i)%higher,n_elems,MPI_INT,&
    0,MPI_COMM_WORLD,req,ier)
  call mpi_wait(req,stat,ier)
  req = 3
  call mpi_ibcast(zone_storage(i)%lo_corner,n_elems,MPI_DOUBLE_PRECISION,&
    0,MPI_COMM_WORLD,req,ier)
  call mpi_wait(req,stat,ier)
  req = 4
  call mpi_ibcast(zone_storage(i)%hi_corner,n_elems,MPI_DOUBLE_PRECISION,&
    0,MPI_COMM_WORLD,req,ier)
  call mpi_wait(req,stat,ier)

  call mpi_barrier(MPI_COMM_WORLD,ier)
end do

write(*,*) 'lower check 2',self,'lower',zone_storage(lvl)%lower
write(*,*) 'higher check 2',self,'high',zone_storage(lvl)%higher
write(*,*) 'lo_corner check ',self,'lo_corner',zone_storage(lvl)%lo_corner
write(*,*) 'hi_corner check ',self,'hi_corner',zone_storage(lvl)%hi_corner
write(*,*) 'big_zones check ',self,'big_zones',zone_storage(lvl)%big_zones

call MPI_FINALIZE(ier)
end program

...

正如我所说，此代码有效，但较大的版本并不总是有效。 OpenMPI 会抛出几个类似的警告：

mca: base: component_find: ess "mca_ess_pmi" 使用无法识别的 MCA 接口（组件 MCA v2.1.0 ！= 支持的 MCA v2.0.0）- 忽略

mca: base: component_find: grpcomm "mca_grpcomm_direct" 使用无法识别的 MCA 接口（组件 MCA v2.1.0 != 支持的 MCA v2.0.0）- 忽略

mca: base: component_find: rcache "mca_rcache_grdma" 使用无法识别的 MCA 接口（组件 MCA v2.1.0 != 支持的 MCA v2.0.0）- 忽略

等等。等等。但即使出现这些警告，程序仍然可以完成。

-有没有办法确保 MPI_bcast 在继续之前将其缓冲区清空到正确的内存区域中？它有时似乎错过了这一点。

-是否有不同/更好的方法来分发数据？尺寸必须能够与测试程序不同。

提前谢谢你。

【问题讨论】：

stackoverflow.com/questions/41380194/… 有什么帮助吗？
mpi_irecv 的等待时间在哪里？
@IanBush 是的，我只是不确定警告是否与问题有关。我要更新 OpenMPI（或者让我的 IT 人员来做，因为我偏执地想把它搞砸）。关于 mpi_irecv，我将它们与阻塞 mpi_sends 和一个 mpi_barrier 配对，所以它应该都可以工作。我可以尝试等待或阻塞 mpi_recv。
请将您的代码缩减为minimal reproducible example，并清楚地描述问题所在以及如何重现它。您也许可以将for() MPI_Bcast() 替换为单个MPI_Allgather()（或需要MPI_Allgatherv()）
@LordOfBunnies 您必须对所有非阻塞通信进行相应的等待。屏障或相应的阻塞调用是不够的。某些 MPI 实现只在等待中完成通信，所以不等待，不通信！

标签： fortran mpi

【解决方案1】：

最直接的答案是使用 MPI_allgatherv。尽管我不想弄乱置换，但这是共享信息和减少整体代码长度的最佳设置。

我相信 MPI_waitall 解决方案也可以，因为数据在广播之前没有被完全接收。

【讨论】：