MPI_TYPE_CONTIGUOUS无法正确处理包含real(8)的自定义类型

Question

在定义mpi_type_contiguous和稍后使用mpi_gatherv时，我遇到了一个奇怪的问题。类型定义为：

type glist
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for int version:
!  integer :: iref , biref
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    real(8) :: rvar
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for buggy version:
    integer :: ciref
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end type glist

现在的代码不起作用。如果我要评论integer :: ciref，它将会工作。如果我注释real(8) :: rvar，而取消注释另外两个整数integer :: iref, biref，情况也是如此。

这意味着错误取决于数据类型的大小，但仅在其中有real(8)的情况下。如果我有一个real(8)和两个int，那么它又可以工作了。

该代码设计为使用3个线程(！)运行。我用openmpi和gfortran (mpif90)运行它。没有特殊的编译标志和mpirun -np 3 filename执行。如果有人能用mpich运行它，或者用ifort或其他什么工具编译它，那将会很有趣，以便找出问题的来源。

-编辑

白猴在下面建议使用mpi_type_struct，但它仍然不起作用。如果我像上面那样用glist做sizeof(glist)，我得到的答案是16而不是12。

- /EDIT

提前感谢您的帮助。

完整的代码是(不用担心，有些代码可以忽略)

module mod_glist
type glist
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for int version:
!  integer :: iref , biref
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    real(8) :: rvar
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for buggy version:
    integer :: ciref
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end type glist

contains

subroutine sof_glist(sof)
    implicit none
    integer, intent(out) :: sof

    type(glist) :: dum
    integer     :: val

    val = 0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for int version:
!  val = kind(dum%iref) + kind(dum%biref)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    val = val + kind(dum%rvar)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for buggy version:
    val = val + kind(dum%ciref)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    sof = val/kind(0)
    write(*,*) 'Size in bytes, integers: ', sof, val
end subroutine

end module mod_glist

program test_mpi_gatherv

use mpi
use mod_glist

    implicit none

    integer                                :: err, np, tp, nglout, i, j, nglin, sofgl, mpi_type_glist
    type(glist), dimension(:), allocatable :: gl, glcom, glsave
    integer    , dimension(:), allocatable :: glsize, nglinv, nglinp
    integer(kind=mpi_address_kind) :: ii, ij

    call mpi_init(err)
    call mpi_comm_size(mpi_comm_world, np, err)
    call mpi_comm_rank(mpi_comm_world, tp, err)
    tp = tp + 1

    call sof_glist(sofgl)
    call mpi_type_contiguous(sofgl, mpi_integer, mpi_type_glist, err)
    call mpi_type_commit(mpi_type_glist, err)
    call mpi_type_get_extent(mpi_type_glist, ii, ij, err)
    write(*,*) 'extend: ', ii, ij

    allocate(glsize(np), nglinv(np), nglinp(np))

    glsize(1) = 5
    glsize(2) = 4
    glsize(3) = 3
    glsize(4:np) = 0

    allocate(gl(glsize(tp)))
    j = 1
    do i = 1,tp-1
      j = j+glsize(i)
    enddo

    do i = 1,glsize(tp)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for int version:
!    gl(i)%iref = j
!    gl(i)%biref = -j
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      gl(i)%rvar = real(j,8)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!uncomment line below for buggy version:
      gl(i)%ciref = -j*10
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      j = j+1
    enddo

    do i=1,np ! setting up stuff can be ignored
      if(i.eq.1)then
        if(tp.eq.i)then
          nglinv(1) = 0
          nglinv(2) = 2
          nglinv(3) = 3
          nglinp(1) = 0
          nglinp(2) = nglinv(1) + nglinp(1)
          nglinp(3) = nglinv(2) + nglinp(2)
          nglin = nglinv(1) + nglinv(2) + nglinv(3)
          allocate(glcom(nglin))
          nglout = 0
        else
          if(tp.eq.2)then
            nglout = 2
            allocate(glcom(nglout))
            glcom(1) = gl(1)
            glcom(2) = gl(3)
          elseif(tp.eq.3)then
            nglout = 3
            allocate(glcom(nglout))
            glcom(1) = gl(1)
            glcom(2) = gl(2)
            glcom(3) = gl(3)
          endif
        endif
      elseif(i.eq.2)then
        if(tp.eq.i)then
          nglinv(1) = 3
          nglinv(2) = 0
          nglinv(3) = 2
          nglinp(1) = 0
          nglinp(2) = nglinv(1) + nglinp(1)
          nglinp(3) = nglinv(2) + nglinp(2)
          nglin = nglinv(1) + nglinv(2) + nglinv(3)
          allocate(glcom(nglin))
          nglout = 0
        else
          if(tp.eq.1)then
            nglout = 3
            allocate(glcom(nglout))
            glcom(1) = gl(2)
            glcom(2) = gl(4)
            glcom(3) = gl(5)
          elseif(tp.eq.3)then
            nglout = 2
            allocate(glcom(nglout))
            glcom(1) = gl(2)
            glcom(2) = gl(3)
          endif
        endif
      elseif(i.eq.3)then
        if(tp.eq.i)then
          nglinv(1) = 0
          nglinv(2) = 2
          nglinv(3) = 0
          nglinp(1) = 0
          nglinp(2) = nglinv(1) + nglinp(1)
          nglinp(3) = nglinv(2) + nglinp(2)
          nglin = nglinv(1) + nglinv(2) + nglinv(3)
          allocate(glcom(nglin))
          nglout = 0
        else
          if(tp.eq.1)then
            nglout = 0
            allocate(glcom(nglout))
          elseif(tp.eq.2)then
            nglout = 2
            allocate(glcom(nglout))
            glcom(1) = gl(1)
            glcom(2) = gl(4)
          endif
        endif
      endif ! end of setting up stuff

      if(i.eq.tp) allocate(glsave(nglin))

      ! debug output
      call mpi_barrier(mpi_comm_world, err)
      write(*,*) i, tp, nglout, nglin
      call mpi_barrier(mpi_comm_world, err)
      if(i.eq.tp) write(*,*) i, nglinv, nglinp
      call mpi_barrier(mpi_comm_world, err)
      ! end debug output

      call mpi_gatherv(glcom, nglout, mpi_type_glist, glsave, nglinv, nglinp, mpi_type_glist, i-1, mpi_comm_world, err)

      if(allocated(glcom)) deallocate(glcom)
    enddo

    ! debug output
    call mpi_barrier(mpi_comm_world, err)
    do i = 1,nglin
      write(*,*) tp, i, glsave(i)
    enddo
    ! end debug output

    call mpi_finalize(err)

end program

Answer 1

您的基本错误是，您不能通过对派生类型组件的大小求和来计算其大小，因为这忽略了满足对齐要求所必需的填充。在您的示例中，real(8)需要在8字节的边界上对齐，因此如果派生类型包含默认的种类整数(大小为4字节)，则编译器将添加4字节的填充，以确保派生类型数组中的下一个元素将从8字节的边界开始。正如MPI struct datatype with an array在回答中指出的那样，这个问题的正确解决方案是定义一个mpi_type_struct：

此外，假设种类数等于类型的大小是不可移植的，那么它恰好在gfortran中起作用。

Answer 2

请参阅我以前关于构建自己的结构的帖子。更可靠，适合任何类型的组合。

MPI struct datatype with an array