未接收所有数据的MPI_Bcast非根节点

Question

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

这最终将进入一个完整的CFD代码，但我想测试它的小规模，以解决but之前，提出更大的代码。下面的程序似乎每次都能工作，但它最初是一个子程序，没有工作。

我遇到了一个问题，不是所有来自MPI_Bcast的数据都是由每个进程接收的.有时候。我可以在相同的代码上点击execute，连续两次，有时会弹出(代码中其他地方的CGNS的分段故障)，有时它可以工作。据我所知，当不是所有来自MPI_Bcast的数据都被及时接收到时，程序就会爆炸，以便在其他地方开始工作。尽管有MPI_wait和MPI_barrier，子例程底部的写将在所有数组的最后六个索引中在lvl=1上抛出垃圾。将信息打印到屏幕上似乎有帮助，但更多的处理器似乎降低了代码工作的可能性。

目前，我已经将其作为带有MPI_ibcast的MPI_wait，但之后我也尝试了MPI_Bcast和MPI_barriers。将通信器从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接口(组件MCAv2.1.0 !=支持MCAv2.0.0) --忽略mca: base: component_find: grpcomm "mca_grpcomm_direct”使用未被识别的MCA接口(组件MCAv2.1.0 !=支持MCAv2.0.0)-忽略mca: base: component_find: rcache "mca_rcache_grdma“使用未被识别的MCA接口(组件MCAv2.1.0 !=支持的MCAv2.0.0)-被忽略

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

-Is --在继续前进之前，有一种方法可以确保MPI_bcast已将其缓冲区清空到正确的内存区域吗？它似乎有时会错过这一切。

-Is有一种不同的/更好的方法来分发数据？大小必须能够变化，不像测试程序。

提前谢谢你。

Answer 1

最简单的答案是使用MPI_allgatherv。尽管我不想破坏位移，但这是共享信息和缩短代码长度的最佳设置。

我相信MPI_waitall解决方案也能工作，因为数据在广播之前还没有被完全接收到。