1

这个问题遵循MPI_type_create_subarray 和 MPI_Gather上的现有线程。我的目标是使用 Fortran 90 中的 MPI_Type_Create_Subarray 和 MPI_Gatherv 将来自所有从属进程（数量为 4）的更大数组的子数组收集到主进程（rank=0）上的更大数组中。这将帮助我理解 MPI_Gatherv项目。以下是我的示例代码：

    program main
    implicit none
    include "mpif.h"
    integer :: ierr, myRank, nProcs
    integer :: sendsubarray, recvsubarray, resizedrecvsubarray
    integer, dimension(2) :: starts,sizes,subsizes
    integer, dimension(:), allocatable :: counts, disps
    integer, parameter :: nx_glb=10, ny_glb=10, nx=5, ny=5
    integer, dimension(:,:), target, allocatable :: mat, matG
    integer, pointer :: sendPtr(:,:), recvPtr(:,:)
    integer :: i, j

    call mpi_init(ierr)
    call mpi_comm_rank(mpi_comm_world, myRank, ierr)
    call mpi_comm_size(mpi_comm_world, nProcs, ierr)

    sizes(1)=nx+2; sizes(2)=ny+2
    subsizes(1)=nx; subsizes(2)=ny
    starts(1)=2; starts(2)=2
    call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
                                mpi_integer, sendsubarray, ierr)
    call mpi_type_commit(sendsubarray,ierr)

    allocate(mat(1:nx+2,1:ny+2))
    do j=1, ny+2
     do i=1, nx+2
      if(i.eq.1 .or. i.eq.nx+2 .or. j.eq.1 .or. j.eq.ny+2) then
       mat(i,j)=1000
      else
       mat(i,j) = myRank
      end if
     end do
    end do

    sendPtr=>mat
    if(myRank.eq.0) then
     allocate(matG(nx_glb,ny_glb))
     matG=1000
     sizes(1)=nx_glb; sizes(2)=ny_glb
     subsizes(1)=nx; subsizes(2)=ny
     starts(1)=1; starts(2)=1
     call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
                                   mpi_integer, recvsubarray, ierr)
     call mpi_type_commit(recvsubarray, ierr)
     call mpi_type_create_resized(recvsubarray, 1, sizeof(i), resizedrecvsubarray, ierr)
     call mpi_type_commit(resizedrecvsubarray,ierr)
     recvPtr=>matG
    end if

    counts(1:4) = (/1, 1, 1, 1/)
    disps(1:4) = (/0, 5, 50, 55/)
    call mpi_gatherv(sendPtr,1,sendsubarray,recvPtr,counts,disps,resizedrecvsubarray, &
                     0,mpi_comm_world,ierr)

    if(myRank.eq.0) then
     do i=1, nx_glb
      write(1000,*) (matG(i,j),j=1, ny_glb)
     end do
    end if

    call mpi_finalize(ierr)

    end program main

但是，执行此代码会导致forrtl: severe(174): SIGSEGV, segmentation fault occurred.

似乎我试图指向一个在收集时尚未初始化或声明的数组的变量/位置。我尝试以多种方式进行调试，但徒劳无功。

提前谢谢了。

4

1 回答 1

1

当你看到这里的主要问题时，你会踢自己；你没有分配计数或显示。

顺便说一句，我强烈建议使用use mpi而不是include mpif.h; use 语句（在隐式 none 之前）引入了 F90 接口，该接口具有更好的类型检查。当您这样做时，您还会看到对于您的类型创建调整大小，您将需要kind mpi_address_kind.

更新：

好的，所以对于如何做gatherv这个更大的问题，你的事情基本上是正确的，但你是对的，starts，disps等必须是零索引，而不是1，因为实际的MPI库是从一个 C 的观点，即使使用 FORTRAN 绑定。所以对于 sendsubarray，starts 必须是[1,1]; 对于 recv 子数组，它必须是[0,0]，并且调整大小，start 必须是 0，extent 必须是 sizeof(type) （并且这两个都必须是 mpi_address_kind 类型的整数）。

我正在附加带有这些更新的代码版本，并且底层数组是字符类型，因此更容易打印出诊断信息并查看发生了什么：

program main
    use mpi
    implicit none
    integer :: ierr, myRank, nProcs
    integer :: sendsubarray, recvsubarray, resizedrecvsubarray
    integer, dimension(2) :: starts,sizes,subsizes
    integer, dimension(:), allocatable :: counts, disps
    integer, parameter :: nx_glb=10, ny_glb=10, nx=5, ny=5
    character, dimension(:,:), target, allocatable :: mat, matG
    character :: c
    integer :: i, j, p
    integer(kind=mpi_address_kind) :: start, extent

    call mpi_init(ierr)
    call mpi_comm_rank(mpi_comm_world, myRank, ierr)
    call mpi_comm_size(mpi_comm_world, nProcs, ierr)

    sizes(1)=nx+2; sizes(2)=ny+2
    subsizes(1)=nx; subsizes(2)=ny
    starts(1)=1; starts(2)=1
    call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
                                mpi_character, sendsubarray, ierr)
    call mpi_type_commit(sendsubarray,ierr)

    allocate(mat(1:nx+2,1:ny+2))
    mat='.'
    forall (i=2:nx+1,j=2:ny+1) mat(i,j)=ACHAR(ICHAR('0')+myRank)

    if(myRank.eq.0) then
     allocate(matG(nx_glb,ny_glb))
     matG='.'
     sizes(1)=nx_glb; sizes(2)=ny_glb
     subsizes(1)=nx; subsizes(2)=ny
     starts(1)=0; starts(2)=0
     call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
                                   mpi_character, recvsubarray, ierr)
     call mpi_type_commit(recvsubarray, ierr)
     extent = sizeof(c)
     start = 0
     call mpi_type_create_resized(recvsubarray, start, extent, resizedrecvsubarray, ierr)
     call mpi_type_commit(resizedrecvsubarray,ierr)
    end if

    allocate(counts(4),disps(4))
    counts(1:4) = (/1, 1, 1, 1/)
    disps(1:4) = (/0, 5, 50, 55/)
    call mpi_gatherv(mat,1,sendsubarray,matG,counts,disps,resizedrecvsubarray, &
                     0,mpi_comm_world,ierr)

    do p=0,nProcs
      if (myRank == p) then
         print *, 'Local array for rank ', myRank
         do i=1, nx+2
          print *, (mat(i,j),j=1,ny+2)
         end do
      endif
      call MPI_Barrier(MPI_COMM_WORLD,ierr)
    enddo
    if(myRank.eq.0) then
     print *, 'Global array: '
     do i=1, nx_glb
      print *, (matG(i,j),j=1, ny_glb)
     end do
    end if

    call mpi_finalize(ierr)

end program main

带输出：

 Local array for rank            0
 .......
 .00000.
 .00000.
 .00000.
 .00000.
 .00000.
 .......
 Local array for rank            1
 .......
 .11111.
 .11111.
 .11111.
 .11111.
 .11111.
 .......
 Local array for rank            2
 .......
 .22222.
 .22222.
 .22222.
 .22222.
 .22222.
 .......
 Local array for rank            3
 .......
 .33333.
 .33333.
 .33333.
 .33333.
 .33333.
 .......
 Global array: 
 0000022222
 0000022222
 0000022222
 0000022222
 0000022222
 1111133333
 1111133333
 1111133333
 1111133333
 1111133333

...有道理？这与此处回答的此问题的 C 版本非常相似（MPI_Type_create_subarray 和 MPI_Gather），但您已经大致弄清楚了……

哦，是的，还有一件事——您实际上不需要在 Fortran 中设置指向发送/接收数据的指针。在 C 中，您需要显式传递指向数据数组的指针；在 fortran 中，您可以只传递数组（并且它们已经“通过引用”传递，例如相当于 C 将指针传递给变量）。所以你可以只传递数组。

于 2011-06-28T18:41:29.640 回答