1

2D配列のすべての要素で計算集約型関数が呼び出されるFortranMPIコードがあります。タスクをランク間で分割しようとしています。たとえば、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()同じように使用してMPI_ALLGATHER()おり、各プロセスとの間で異なる数の要素を送信する機能の恩恵を受けていません。しかし、それはあなたのプログラムのエラーではありません。エラーはそれが満たされる方法にありますmyarr。として割り当てますが、列から列myarr(x,mycolumns)に入力するときは、すべてのプロセスで配列の終わりを超えますが、それ以降はランク付けされ、そこよりも大きくなります。したがって、ランクに1つだけ含まれ、他のすべてのランクには0が含まれます。したがって、はい、最終的な配列には期待する値がありませんが、これは、MPIサブルーチンの使用方法ではなく、間違って入力したためです。jbje0jbjemycolumnsmyarr0

割り当て可能な配列の終わりを超えて書き込むと、ヒープ割り当ての管理に使用される隠し構造が破壊され、通常はプログラムがクラッシュします。あなたの場合、あなたは幸運です-私はあなたのコードをOpen MPIで実行し、毎回コアダンプでクラッシュしました。

MPI_FINALIZE()また、コードの最後にへの呼び出しがありません。

ヒント：可能な場合はFortran90インターフェースを使用include 'mpif.h'してください。use mpi

于 2012-07-20T08:15:35.640 に答える
0

here is the final version of the code. I have implemented the fixes suggested by "Hristo Iliev" and also fixed the part where the # or ranks does not equally divide the # of columns. Here the last rank does the computation on the leftover columns.

    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 に答える