MPI能否收集、约简、发送和接收Fortran派生类型？

Question

我想把派生类型xyzBuffer从处理器1复制到处理器0的xyz。我尝试使用MPI_GATHER，代码如下：

 call MPI_GATHERV(xyzBuffer,1,inewtype,xyz,1, dispGather,inewtype,0,icomm,ierr)

但是处理器0将拥有未写入的内存位：似乎MPI_GATHER不允许收集派生类型。我使用了MPI_ISEND/MPI_IRECV，但程序在以下代码行挂起：

 if ( iproc == 1 ) then
       call MPI_ISEND(xyz,1,inewtype,1,itag,icomm,ireq,ierr)
       call MPI_WAIT(ireq,istatus,ierr)
    else if ( iproc == 0 ) then 
       call MPI_IRECV(xyz,1,inewtype,0,itag,icomm,ireq,ierr)
       call MPI_WAIT(ireq,istatus,ierr)
    end if

这些方法不能用于派生类型吗？

以下是完整的程序。在测试MPI_ISEND、MPI_IRECV代码块时，我注释掉了MPI_GATHER，并反之亦然。

program type_derived_gather
  use nodeinfo
  implicit none
  include 'mpif.h'
  integer(4) :: ierr
  integer(4) :: istatus(MPI_STATUS_SIZE)
  integer(4) :: i
  integer(4) :: j
  integer(4) :: iblock(8)
  integer(4) :: idisp(8)
  integer(4) :: itype(8)
  integer(4) :: inewtype
  integer(4) :: iextent
  integer(4) :: itag
  integer(4) :: ireq, isend, irecv
  integer(4) :: dispGather ! for root

    TYPE :: newXYZ
        integer :: x, u
        integer :: y, v
        integer :: z, w
        integer,dimension(3) :: uvw     
    END TYPE

    TYPE (newXYZ) :: xyzBuffer
    TYPE (newXYZ) :: xyz


  call MPI_INIT(ierr)
  icomm = MPI_COMM_WORLD
  call MPI_COMM_SIZE(icomm,nproc,ierr)
  call MPI_COMM_RANK(icomm,iproc,ierr)


    if (iproc == 1) then
        xyz%x = 1
        xyz%y = 2
        xyz%z = 3
        xyz%u = 4
        xyz%v = 5
        xyz%w = 6
        xyz%uvw = (/10,10,10/)
    else
        xyz%x = 0
        xyz%y = 0       
        xyz%z = 0
        xyz%u = 0
        xyz%v = 0       
        xyz%w = 0 
        xyz%uvw = (/0,0,0/)
    endif


! Derived type
  iblock(1) = 1
  iblock(2) = 1
  iblock(3) = 1
  iblock(4) = 1
  iblock(5) = 1
  iblock(6) = 1
  iblock(7) = 3
  iblock(8) = 1

  idisp(1)  = 0  ! in bytes
  idisp(2)  = 4*1  ! in bytes
  idisp(3)  = 4*2  ! in bytes 
  idisp(4)  = 4*3  ! in bytes 
  idisp(5)  = 4*4  ! in bytes
  idisp(6)  = 4*5  ! in bytes 
  idisp(7)  = 4*6  ! in bytes 
  idisp(8)  = 4*9  ! in bytes    

  itype(1)  = MPI_INTEGER
  itype(2)  = MPI_INTEGER
  itype(3)  = MPI_INTEGER
  itype(4)  = MPI_INTEGER
  itype(5)  = MPI_INTEGER
  itype(6)  = MPI_INTEGER
  itype(7)  = MPI_INTEGER
  itype(8)  = MPI_UB  
  call MPI_TYPE_STRUCT(8,iblock,idisp,itype,inewtype,ierr)
  call MPI_TYPE_EXTENT(inewtype,iextent,ierr)
  write(6,*)'newtype extent = ',iextent  
  call MPI_TYPE_COMMIT(inewtype,ierr)

    itag = 1
    dispGather = 0


  do j = 1, 2
     if ( j == 2 ) then
! Gather
        call MPI_GATHERV(xyzBuffer,1,inewtype,xyz,1, dispGather,inewtype,0,icomm,ierr)
! Isend Irecv 
        if ( iproc == 1 ) then
           call MPI_ISEND(xyz,1,inewtype,1,itag,icomm,isend,ierr)
           write(6,*)'end send'
           call MPI_WAIT(isend,istatus,ierr)
        else if ( iproc == 0 ) then
           call MPI_IRECV(xyz,1,inewtype,0,itag,icomm,irecv,ierr)
           write(6,*)'end receive'
           call MPI_WAIT(irecv,istatus,ierr)
        end if
! Output 
     end if      
     call MPI_BARRIER(icomm,ierr)
     if ( iproc == 0 )write(6,*)'iproc = ',iproc
        if ( iproc == 0 ) write(6,*)xyz

     call MPI_BARRIER(icomm,ierr)
     if ( iproc == 1 )write(6,*)'iproc = ',iproc
        if ( iproc == 1 ) write(6,*)xyz
  end do

  call MPI_FINALIZE(ierr)
end program type_derived_gather

当我使用MPI_ISEND和MPI_IRECV时，程序阻塞了，输出是：

 iproc =            0
           0           0           0           0           0           0           0           0           0
 end receive
 newtype extent =           36
 iproc =            1
           1           4           2           5           3           6          10          10          10
 end send

当MPI_GATHER运行时，我会收到一个“分段错误”，并输出：

 newtype extent =           36
 iproc =            0
           0           0           0           0           0           0           0           0           0
 newtype extent =           36
 iproc =            1
           1           4           2           5           3           6          10          10          10
 newtype extent =           36
 newtype extent =           36
 newtype extent =           36
 newtype extent =           36
 newtype extent =           36
 newtype extent =           36
[west0302:17101] *** Process received signal ***
[west0302:17101] Signal: Segmentation fault (11)
[west0302:17101] Signal code: Address not mapped (1)
[west0302:17101] Failing at address: 0x7ff2c8d1ddc0
[west0302:17101] [ 0] /lib64/libpthread.so.0 [0x3d3540eb70]
[west0302:17101] [ 1] /lib64/libc.so.6(memcpy+0xe1) [0x3d3487c321]
[west0302:17101] [ 2] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib64/libmpi.so.0(ompi_convertor_unpack+0x153) [0x2acd5f392093]
[west0302:17101] [ 3] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_pml_ob1.so(mca_pml_ob1_recv_request_progress+0x7d1) [0x2acd6423dd91]
[west0302:17101] [ 4] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_pml_ob1.so [0x2acd6423a4c7]
[west0302:17101] [ 5] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_btl_sm.so(mca_btl_sm_component_progress+0xde2) [0x2acd64ca81c2]
[west0302:17101] [ 6] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_bml_r2.so(mca_bml_r2_progress+0x2a) [0x2acd6444504a]
[west0302:17101] [ 7] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib64/libopen-pal.so.0(opal_progress+0x4a) [0x2acd5f84a9ba]
[west0302:17101] [ 8] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_pml_ob1.so(mca_pml_ob1_recv+0x2b5) [0x2acd64238565]
[west0302:17101] [ 9] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib/openmpi/mca_coll_basic.so(mca_coll_basic_gatherv_intra+0x14a) [0x2acd650bb37a]
[west0302:17101] [10] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib64/libmpi.so.0(MPI_Gatherv+0x1b0) [0x2acd5f3a4170]
[west0302:17101] [11] /n/sw/openmpi-1.2.5-gcc-4.1.2/lib64/libmpi_f77.so.0(mpi_gatherv__+0x134) [0x2acd5f142784]
[west0302:17101] [12] ./type_derived_gather.x(MAIN__+0x342) [0x401742]
[west0302:17101] [13] ./type_derived_gather.x(main+0xe) [0x403fee]
[west0302:17101] [14] /lib64/libc.so.6(__libc_start_main+0xf4) [0x3d3481d994]
[west0302:17101] [15] ./type_derived_gather.x [0x401349]
[west0302:17101] *** End of error message ***

- Pippi

---

你的实际问题是什么？你所说的“generation”是什么意思？你想要数据分发吗？无论如何，答案很可能是肯定的。 - haraldkl

Answer 1

可以的，你肯定可以这样做：你的代码在MPI_Isend()/MPI_Irecv()上卡住的问题是你发送/接收到了错误的进程；你想让1给0发送，0给1发送，而不是1给1发送，0从0接收。因为0永远不会接收到那个幻影消息（因为它不存在），所以你一直卡住了。

    if ( iproc == 1 ) then
       call MPI_ISEND(xyz,1,inewtype,1,itag,icomm,isend,ierr)
       write(6,*)'end send'
       call MPI_WAIT(isend,istatus,ierr)
    else if ( iproc == 0 ) then
       call MPI_IRECV(xyz,1,inewtype,0,itag,icomm,irecv,ierr)
       write(6,*)'end receive'
       call MPI_WAIT(irecv,istatus,ierr)
    end if

应该是

    if ( iproc == 1 ) then
       call MPI_ISEND(xyz,1,inewtype,0,itag,icomm,isend,ierr)
       call MPI_WAIT(isend,istatus,ierr)
    else if ( iproc == 0 ) then
       call MPI_IRECV(xyz,1,inewtype,1,itag,icomm,irecv,ierr)
       call MPI_WAIT(irecv,istatus,ierr)
    end if

对于更大的问题，可以使用MPI_Type_create_struct()（注意，应该使用这个较新的例程而不是MPI_Create_struct()）用于Fortran派生数据类型。正如@elorenz所指出的那样，手动计算偏移量不仅繁琐和容易出错，而且可能不正确；编译器有很多自由来填充等以实现高效的内存访问。在您的情况下，它可能会工作，因为所有内容都是整数，但对于字段大小混合的类型，您将遇到麻烦。

处理它的正确方法是使用MPI_Get_address为您计算字段偏移量；下面是一个完整的示例。

program type_derived_gather
  use iso_fortran_env
  use mpi
  implicit none
  integer :: ierr
  integer, parameter :: nfields=4
  integer :: iblock(nfields)
  integer(kind=MPI_ADDRESS_KIND) :: start, idisp(nfields)
  integer :: itype(nfields)
  integer :: inewtype
  integer :: nproc, iproc
  integer :: i

  type :: newXYZ
       integer :: id
       real(kind=real64) :: x, y, z
  end type

  type(newXYZ), dimension(:), allocatable :: allxyzs
  type(newXYZ) :: locxyz

  call MPI_INIT(ierr)
  call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
  call MPI_COMM_RANK(MPI_COMM_WORLD,iproc,ierr)

  locxyz % x  = 1.d0*iproc
  locxyz % y  = 2.d0*iproc
  locxyz % z  = 3.d0*iproc
  locxyz % id = iproc

  if (iproc == 0) allocate(allxyzs(nproc))

  ! everyone builds the type

  iblock = 1

  itype(1)  = MPI_INTEGER
  itype(2:4)= MPI_DOUBLE_PRECISION

  call MPI_Get_address(locxyz,    start, ierr)
  call MPI_Get_address(locxyz%id, idisp(1), ierr)
  call MPI_Get_address(locxyz%x,  idisp(2), ierr)
  call MPI_Get_address(locxyz%y,  idisp(3), ierr)
  call MPI_Get_address(locxyz%z,  idisp(4), ierr)

  idisp = idisp - start

  call MPI_Type_create_struct(nfields,iblock,idisp,itype,inewtype,ierr)
  call MPI_Type_commit(inewtype,ierr)

  ! Now gather the structs

  print '(A,I3,A,I3,1X,3(F6.2,1X))', 'Rank ', iproc, ': locxyz = ', locxyz%id, locxyz%x, locxyz%y, locxyz%z

  call MPI_Gather(locxyz, 1, inewtype, allxyzs, 1, inewtype, 0, MPI_COMM_WORLD, ierr)

  if (iproc == 0) then
      print '(A,I3,A)', 'Rank ', iproc, ' has -- '
      do i=1, nproc
          print '(A,I3,A,I3,1X,3(F6.2,1X))', '    ', i, ': ', allxyzs(i)%id, allxyzs(i)%x, allxyzs(i)%y, allxyzs(i)%z
      enddo
      deallocate(allxyzs)
  end if

  call MPI_FINALIZE(ierr)

end program type_derived_gather

- Jonathan Dursi

Answer 2

可以的，但是请确保在定义数据类型时使用“序列”！否则编译器可能会在内存中对类型成员进行对齐，这可能会导致复制缓冲区时出现一些混乱的数据。

- elorenz

Answer 3

当然，您可以使用MPI_Gather（或其他集合）与派生数据类型。任何需要MPI_Datatype参数的MPI函数都可以与派生数据类型一起使用。如果您发布一个最小的示例，说明如何构造和使用派生数据类型，我们可能会更好地帮助您。

- timos

---

谢谢，程序已发布。我将非常感激您的帮助！ - Pippi