1

この質問は、MPI_type_create_subarray および MPI_Gatherに関する既存のスレッドに従います。私の目的は、Fortran 90 で MPI_Type_Create_Subarray と MPI_Gatherv を使用して、すべてのスレーブ プロセス (数が 4) からより大きな配列のサブ配列をマスター プロセス (ランク = 0) 上のより大きな配列に集めることです。プロジェクト。以下は私のサンプルコードです：

    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

ここで主な問題が発生すると、あなたは自分自身を蹴るでしょう。counts または disp を割り当てませんでした。

余談ですが、 ;use mpiではなくinclude mpif.h;を使用することを強くお勧めします。use ステートメント (暗黙的な none の前) は、型チェックがはるかに優れた F90 インターフェイスをもたらします。これを行うと、タイプの作成のサイズが変更されると、整数が必要になることもわかりますkind mpi_address_kind。

更新：

さて、gatherv をどのように実行するかというより大きな問題については、おおむね正しいことがわかりましたが、実際の MPI ライブラリは次のことを行っているため、starts、disps などは 1 ではなく 0 でインデックス付けする必要があります。 FORTRAN バインディングを使用した場合でも、C の観点から。したがって、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 ) と非常によく似ていますが、ほとんどのことは既にわかっています...

そうそう、もう 1 つ、Fortran で send/recv データへのポインターを実際に設定する必要はありません。C では、ポインタをデータの配列に明示的に渡す必要があります。Fortran では、単に配列を渡すことができます (そして、それらは既に「参照によって」渡されています。たとえば、C の変数へのポインターの受け渡しと同等です)。したがって、配列を渡すだけです。

于 2011-06-28T18:41:29.640 に答える