1

我有一个 fortran MPI 代码，其中在 2D 数组的每个元素上调用计算密集型函数。我正在尝试在队伍中分配任务。例如，如果有 30 列和 10 个等级，则每个等级有 3 列。以下代码执行此拆分并使用 allgather 收集结果。但是最终的数组没有所有等级的值。

        program allgather
    include 'mpif.h'
    !create a 2 x 30 myarray
    integer :: x=2,y=30
    integer :: numprocs,myid
    integer :: i,j,k,myelements,mycolumns,jb,je
    integer*4,dimension(:),allocatable :: displacement,recvcnt
    real :: checksum
    real,dimension(:,:),allocatable :: myarr,combinedarr
    call MPI_INIT(IERR)
    call MPI_COMM_SIZE(MPI_COMM_WORLD,NUMPROCS,IERR)
    call MPI_COMM_RANK(MPI_COMM_WORLD,MYID,IERR)
    mycolumns = y/numprocs
    myelements = x * mycolumns
    allocate(displacement(numprocs),recvcnt(numprocs))
    jb = 1 + ( myid * mycolumns ) 
    je = ( myid + 1 ) * mycolumns
    allocate(myarr(x,mycolumns))
    allocate(combinedarr(x,y))
    myarr(:,:) =0
    do j=jb,je
      do i=1,x
       myarr(i,j) = 1
      enddo
    enddo
    !myarr(:,:)=1 
    if(mod(y,numprocs) > 0) then
     if(myid==numprocs-1) then
       jb=(myid + 1) * mycolumns + 1
       do j=jb,y 
        do i=1,x
          myarr(i,j) = 1
        enddo
      enddo 
     endif
    endif
    combinedarr(:,:) =0
    recvcnt(:)=myelements
    do k=1,numprocs
    displacement(k) = (k-1) *myelements
    enddo
    call MPI_ALLGATHERV(myarr,myelements,MPI_REAL,combinedarr,recvcnt,displacement,MPI_REAL,MPI_COMM_WORLD,IERR)
    if(mod(y,numprocs) > 0) then
     recvcnt(:) = 0
     recvcnt(numprocs) = (x*y) - myelements * (numprocs)
     displacement(numprocs) = displacement(numprocs) + myelements
     call MPI_ALLGATHERV(myarr,recvcnt(numprocs),MPI_REAL,combinedarr,recvcnt,displacement,MPI_REAL,MPI_COMM_WORLD,IERR)
    endif
    if (myid==0) then 
    checksum=0
     write(6,*) "mycolumns:",mycolumns,"myelements:",myelements 
    do j=1,y
      do i=1,x
       checksum = checksum + combinedarr(i,j)
      enddo
     enddo
       write(6,*) checksum 
    endif
    end
4

2 回答 2

5

首先，您使用的MPI_ALLGATHERV()是 asMPI_ALLGATHER()并且没有从它从/向每个进程发送不同数量的元素的能力中获得任何好处。但这不是您程序中的错误。错误在于它的填充方式myarr。您将其分配为，但是当从 column到 columnmyarr(x,mycolumns)填充它时，您在所有进程中都超过了数组的末尾，但排名从那时起并且大于那里。因此，仅在等级中包含 1，在所有其他等级中包含零。所以，是的，最终数组没有您期望的值，但那是因为您填错了它们，而不是因为使用 MPI 子例程的方式。jbje0jbjemycolumnsmyarr0

写入可分配数组的末尾会破坏用于管理堆分配的隐藏结构，并且通常会使程序崩溃。在您的情况下，您很幸运-我使用 Open MPI 运行您的代码，并且每次都因核心转储而崩溃。

而且您还错过了MPI_FINALIZE()代码末尾的调用。

提示：如果可用，请使用 Fortran 90 界面 - 替换include 'mpif.h'为use mpi

于 2012-07-20T08:15:35.640 回答
0

这是代码的最终版本。我已经实施了“Hristo Iliev”建议的修复，还修复了 # 或排名不均分列 # 的部分。这里最后一个排名对剩余列进行计算。

    program allgather
    include 'mpif.h'
    !create a 2 x 30 myarray
    integer :: x=4,y=6
    integer :: numprocs,myid
    integer :: i,j,k,myelements,mycolumns,jb,je,jbb
    integer*4,dimension(:),allocatable :: displacement,recvcnt
    real :: checksum
    real,dimension(:,:),allocatable :: myarr,combinedarr
    call MPI_INIT(IERR)
    call MPI_COMM_SIZE(MPI_COMM_WORLD,NUMPROCS,IERR)
    call MPI_COMM_RANK(MPI_COMM_WORLD,MYID,IERR)
    mycolumns = y/numprocs
    myelements = x * mycolumns
    allocate(displacement(numprocs),recvcnt(numprocs))
    jb = 1 + ( myid * mycolumns ) 
    je = ( myid + 1 ) * mycolumns
    allocate(myarr(x,y))
    allocate(combinedarr(x,y))
    myarr(:,:) =0
    do j=jb,je
      do i=1,x
       myarr(i,j) = (j-1) * x + i
      enddo
    enddo
    if(mod(y,numprocs) > 0) then
     if(myid==numprocs-1) then
       jbb=(myid + 1) * mycolumns + 1
       do j=jbb,y 
        do i=1,x
           myarr(i,j) = (j-1) * x + i
        enddo
      enddo 
     endif
    endif
    combinedarr(:,:) =0
    recvcnt(:)=myelements
    do k=1,numprocs
    displacement(k) = (k-1) *myelements
    enddo
    call MPI_ALLGATHERV(myarr(1,jb),myelements,MPI_REAL,combinedarr,recvcnt,displacement,MPI_REAL,MPI_COMM_WORLD,IERR)
    if(mod(y,numprocs) > 0) then
     recvcnt(:) = 0
     recvcnt(numprocs) = (x*y) - myelements * (numprocs)
     displacement(numprocs) = displacement(numprocs) + myelements
     call MPI_ALLGATHERV(myarr(1,jbb),recvcnt(numprocs),MPI_REAL,combinedarr,recvcnt,displacement,MPI_REAL,MPI_COMM_WORLD,IERR)
    endif
    if (myid==0) then 
    checksum=0
     write(6,*) "mycolumns:",mycolumns,"myelements:",myelements 
    do j=1,y
      do i=1,x
       checksum = checksum + combinedarr(i,j)
      enddo
     enddo
       write(6,*) checksum 
    endif
    end
于 2012-07-20T23:50:08.700 回答