0
mpi_type_contiguousを定義し、後でmpi_gathervを使用すると奇妙な問題が発生します。 タイプは次のように定義されています。コードは、それが今であるように動作しないMPI_TYPE_CONTIGUOUSがreal（8）を含むカスタムタイプで正しく動作しない
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の代わりにコメントし、他の2つの整数のコメントを外す場合は同じです。integer :: iref, biref
つまり、間違いはデータ型のサイズに依存しますが、そこにはreal(8)がある場合のみです。私に1つのreal(8)と2つのintがあれば、それは再び動作します。
コードは3つのスレッド（！）で実行するように設計されています。私はopenmpiとgfortran（mpif90）で実行していました。特殊なコンパイルフラグはありません。mpirun -np 3 filenameで実行してください。もし誰かがmpichでそれを動かすことができたり、問題がどこから来ているのかを知るために、それが興味深いものがあればそれをコンパイルしてください。
--- EDIT ---
Platinummonkeyはmpi_type_structを使用するには、以下の提案が、それはまだ動作しません。私は上記のようにのGListとsizeof(glist)をすれば、私の代わりに12
の答えとして16を得る---/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
ありがとうございます。はい、私はちょうど別のサイトで種類の問題を発見しました。 私も見つけました：http://software.intel.com/en-us/forums/showpost.php?p=137806 sizeof（glist）は最大の要素で割り切れることを指摘しています。だからこれは私の問題がすべて発生したことです。だから私は1つの変数を取り除くか、別の変数を追加する必要があり、不必要なオーバーヘッドが発生します。私は特定のケースで本当の（8）が常に0より大きいので、私はブールを取り除くことができると思う。 – Azrael3000