对 Fortran 使用 MPI_Gatherv

发布于 2024-11-17 17:11:57 字数 2425 浏览 3 评论 0原文

此问题遵循MPI_type_create_subarray 和 MPI_Gather 上的现有线程。我的目标是使用 Fortran 90 中的 MPI_Type_Create_Subarray 和 MPI_Gatherv 将所有从属进程(数量为 4)的更大数组的子数组收集到主进程(等级=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: strict(174): SIGSEGV,发生分段错误

似乎我试图指向在收集时尚未初始化或声明的数组的变量/位置。我尝试了很多方法来调试,但都是徒劳。

非常感谢。

This question follows an existing thread on MPI_type_create_subarray and MPI_Gather. My aim is to gather subarrays of a bigger array from all the slave processes (4 in number) into a larger array on a master process (rank=0) using MPI_Type_Create_Subarray and MPI_Gatherv in Fortran 90. This would help me understand MPI_Gatherv for my other projects. Following is my sample code:

    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

However, executing this code results in forrtl: severe(174): SIGSEGV, segmentation fault occurred.

It seems like I am trying to point to a variable/location of an array that has not be initialized or declared while gathering. I tried to debug in many ways, but in vain.

Many thanks in advance.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

诗化ㄋ丶相逢 2024-11-24 17:11:57

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

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

更新

好吧,对于如何进行收集的更大问题,你的想法基本上是正确的,但你是对的,开始、显示等必须是零索引,而不是1,因为实际的 MPI 库是从 C 的角度做事的,即使使用 FORTRAN 绑定也是如此。因此对于 sendsubarray,开始必须是 [1,1];对于recv子数组,它必须是[0,0],并且调整大小,开始必须是0,范围必须是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 )但是你已经弄清楚了大部分事情......

哦,是的,还有一件事 - 你实际上不需要设置指向发送/接收数据的指针福特兰语言。在 C 语言中,您需要显式传递指向数据数组的指针;在 fortran 中,您可以只传递数组(并且它们已经“通过引用”传递,例如相当于 C 传递指向变量的指针)。所以你可以只传递数组。

You'll kick yourself when you see the main problem here; you didn't allocate counts or disps.

As an aside, I strongly recommend using use mpi rather than include mpif.h; the use statement (before the implicit none) brings in the F90 interface which has much better typechecking. When you do that, you'll also see that for your type create resized, you'll need integers of kind mpi_address_kind.

Update:

Ok, so for the larger question of how to do the gatherv, you had things largely right, but you're right, the starts, disps etc have to be zero-indexed, not 1, because the actual MPI library is doing things from a C point of view, even with the FORTRAN bindings. So for the sendsubarray, starts have to be [1,1]; for the recv subarray it has to be [0,0], and the resize, start has to be 0 and extent has to be sizeof(type) (and both those have to be integers of kind mpi_address_kind).

I'm attaching a version of your code with those updates, and with the underlying arrays being of type character so it's easier to print out diagnostics and see what's going on:

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

With output:

 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

...make sense? This is very similar to the C version of this question which is answered here ( MPI_Type_create_subarray and MPI_Gather ) but you had already figured things mostly out...

Oh, yeah, one more thing -- you don't actually need to set up pointers to the send/recv data in Fortran. In C, you need to explicitly pass pointers to arrays of data; in fortran, you can just pass arrays (and they are already passed "by reference", eg the equivalent of C's passing pointers to a variable). So you can just pass the array.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文