使用MPI_Gatherv Fortran的

Question

這一個問題，在MPI_type_create_subarray和MPI_Gather現有主題。我的目標是從所有從屬進程（4號）收集一個更大的陣列的子陣列成上的主處理的更大的陣列中的Fortran 90使用MPI_Type_Create_Subarray和MPI_Gatherv（秩= 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這段代碼執行的結果。

好像我想指出，同時收集尚未初始化或聲明的數組變量/位置。我試圖用很多方式進行調試，但徒勞無益。

非常感謝提前。

Answer 1

，當你看到這裏的主要問題，你會踢自己;你沒有分配計數或disps。

順便說一句，我強烈建議使用use mpi而非include mpif.h;使用語句（在隱式無）之前引入了具有更好類型檢查的F90接口。當你這樣做時，你也會看到，對於你的類型創建調整大小，你需要整數kindmpi_address_kind。

更新：

好了，所以對於怎麼辦gatherv一個更大的問題，你有事情主要是對的，但你說的沒錯，在開始，disps等必須從零開始索引，不是1，因爲即使使用FORTRAN綁定，實際的MPI庫也是從C角度進行操作。所以對於sentubarray，首先必須是[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 and MPI_Gather），但你已經計算出了大部分的東西...

哦，是的，還有一件事 - 你實際上不需要設置up指向Fortran中的send/recv數據。在C中，你需要顯式地傳遞指向數組數組的指針;在Fortran中，你可以傳遞數組（並且它們已經被「通過引用」傳遞，例如C的傳遞指針變量的等價物）。所以你可以傳遞數組。