按列逐列分割2D数组并使用allgather [英] partition a 2D array column-wise and use allgather

问题描述

我有一个Fortran MPI代码，其中在2D数组的每个元素上调用一个计算密集型函数。我正试图将这些任务分配给队伍。例如，如果有30列和10个等级，那么每个等级都有3列。下面的代码会分割并使用allgather收集结果。但是最终的数组没有来自所有级别的值。

  program allgather 
 include'mpif.h' 
！创建一个2 x 30 myarray 
整数:: x = 2，y = 30 
整数:: numprocs，myid 
整数:: 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（位移（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 
位移（k）=（k-1）* myelements 
 enddo 
调用MPI_ALLGATHERV（myarr，myelements，MPI_REAL， （mod（y，numprocs）> 0）然后
 recvcnt（:) = 0 
 recvcnt（numprocs）=（x（合计），recvcnt，displacement，MPI_REAL，MPI_COMM_WORLD，IERR） * myelements *（numprocs）
位移（numprocs）=位移（numprocs）+ myelements 
调用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 
  MPI_ALLGATHERV（）    $ c>就像 MPI_ALLGATHER（）一样，并且不能从每个进程发送不同数量的元素。但这不是你的程序中的错误。错误在于它填充 myarr 的方式。您将它分配为 myarr（x，mycolumns），但是当它从列 jb 填充到列 je ，你会在所有进程中超过数组的末尾，但从 jb  0  c>和 je 大于 mycolumns 那里。因此， myarr 仅包含 0 中的所有其他等级的零。所以，是的，最终数组没有你期望的值，但这是因为你填充它们错了，不是因为MPI子程序的使用方式。
 
 
 
写过去可分配数组的末尾会销毁用于管理堆分配的隐藏结构，并且通常会使程序崩溃。在你的情况下，你是幸运的 - 我使用Open MPI运行你的代码，并且它每次都会与核心转储崩溃。
 
 
 
而且你也错过了调用<$ c 
 
 
提示：使用Fortran 90接口（如果可用） - 将<$ c $>替换为<$ c $>在代码末尾添加$ c> MPI_FINALIZE（） c>包含'mpif.h'与使用mpi  
 
I have a fortran MPI code in which a compute intensive function is invoked on every element of a 2D array. I'm trying to split the tasks among the ranks. For example if there are 30 columns and 10 ranks, then each rank gets 3 columns. The following code does this split and gathers the results using allgather. But the final array doesn't have the values from all ranks.
        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

解决方案
First of all, you are using MPI_ALLGATHERV() just as MPI_ALLGATHER() and get no benefit from its ability to send different number of elements from/to each process. But that's not the error in your program. The error lies in the way it fills myarr. You allocate it as myarr(x,mycolumns) but when filling it from column jb to column je, you go past the end of the array in all processes but rank 0 since jb and je are greater than mycolumns there. Thus myarr contains ones only in rank 0 and zeroes in all other ranks. So, yes, the final array does not have the values that you expect but that's because you filled them wrong, not because of the way MPI subroutines are used.

Writing past the end of an allocatable array destroys the hidden structures that are used to manage heap allocation and usually crashes the program. In your case you are just lucky - I run your code with Open MPI and it crashed with core dumps each time.

And you are also missing a call to MPI_FINALIZE() at the end of your code.

Hint: use the Fortran 90 interface if available - replace include 'mpif.h' with use mpi

                        
这篇关于按列逐列分割2D数组并使用allgather的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！