Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/fortran/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Fortran MPI_类型';t无法正确使用包含实数(8)的自定义类型_Fortran_Mpi_Fortran90_Openmpi - Fatal编程技术网

Fortran MPI_类型';t无法正确使用包含实数(8)的自定义类型

Fortran MPI_类型';t无法正确使用包含实数(8)的自定义类型,fortran,mpi,fortran90,openmpi,Fortran,Mpi,Fortran90,Openmpi,我有一个奇怪的问题,就是定义一个mpi_类型并在以后使用mpi_gatherv。 该类型定义为: type glist !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !uncomment line below for int version: ! integer :: iref , biref !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(8) :: rvar !!!!!!!!!!!!!!!!!!!!!!

我有一个奇怪的问题,就是定义一个mpi_类型并在以后使用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-np3文件名
没有特殊的编译标志和执行。如果有人可以用mpich运行它,或者用ifort编译它,或者其他有趣的东西来找出问题的根源

---编辑---

Platinumonkey建议在下面使用
mpi\u type\u struct
,但它仍然不起作用。如果我用上面的glist做一个
sizeof(glist)
,我得到的答案是16而不是12

---/编辑---

提前感谢你的帮助

完整的代码是(不要担心,有些代码可能会被忽略)


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


查看我以前关于构建自己的结构的帖子。更可靠,适合任何类型的组合


您的基本错误是,无法通过对派生类型的组件大小求和来计算派生类型的大小,因为这忽略了满足对齐要求所必需的填充。在您的示例中,实数(8)需要在8字节边界上对齐,因此如果派生类型包含默认种类整数(大小为4字节),则编译器将添加4字节的填充,以确保派生类型数组中的下一个元素将在8字节边界上开始。正如Platinumonkey在回答中指出的,这个问题的正确解决方案是定义一个mpi_type_结构:


另外,假设种类号与类型的大小相等,并且不可移植,它恰好在gfortran中工作。

您的基本错误是无法通过对派生类型的组件大小求和来计算派生类型的大小,因为这忽略了满足对齐要求所需的填充。在您的示例中,实数(8)需要在8字节边界上对齐,因此如果派生类型包含默认种类整数(大小为4字节),则编译器将添加4字节的填充,以确保派生类型数组中的下一个元素将在8字节边界上开始。正如Platinumonkey在回答中指出的,这个问题的正确解决方案是定义一个mpi_type_结构:


另外,假设种类数与类型的大小相等,并且不可移植,它正好在gfortran中工作。

Ah cheers。我在另一篇文章中看到了你的链接。因此,“连续”仅适用于相同类型的数据。很高兴知道。事实上它还是不起作用。我稍后会详细调查。现在我只能告诉你
sizeof(glist)
返回24(包含1个bool,2个int,1个real(8)=20个字节)。这是4字节太多。如果我添加了另一个int(因此该类型实际上有24个字节),它可以与
mpi_type_struct
(也可以与continuous一起使用)。请查看对其他答案的注释,特别是我提供的链接。啊,干杯。我在另一篇文章中看到了你的链接。因此,“连续”仅适用于相同类型的数据。很高兴知道。事实上它还是不起作用。我稍后会详细调查。现在我只能告诉你
sizeof(glist)
返回24(包含1个bool,2个int,1个real(8)=20个字节)。这是4字节太多。如果我添加另一个int(因此该类型实际上有24个字节),它可以与
mpi_type_struct
(但也可以与continuous一起使用)。请查看对其他答案的注释,特别是我提供的链接。谢谢。是的,我刚刚在另一个网站上发现了类似的问题。我还发现:它指出sizeof(glist)可以被最大元素整除。这就是我所有问题的根源。因此,要么我需要去掉一个变量,要么添加另一个变量,导致不必要的开销。我想我可以去掉bool,因为在我的具体情况下,真实值(8)总是大于0。谢谢。是的,我刚刚在另一个网站上发现了类似的问题。我还发现:它指出sizeof(glist)可以被最大元素整除。这就是我所有问题的根源。因此,要么我需要去掉一个变量,要么添加另一个变量,导致不必要的开销。我想我可以去掉bool,因为在我的特定情况下,真实值(8)总是大于0。
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