Fortran90 derived types with mpi, alignment issue?

问题:

I got problem with the following basic code:

program foo

  use mpi

  implicit none

  type bartype
     real(8) :: x
     integer :: i
  end type bartype

  integer :: mpi_bar_type

  integer ::                            &
       count=2,                         &
       blocklengths(2)=(/1,1/),         &
       types(2)=(/mpi_double_precision, &
                  mpi_integer/)
  integer(kind=mpi_address_kind) :: displs(2)
  type(bartype) :: bar, bararray(4)
  integer :: rank, ierr, i, test(4), addr0


  call mpi_init(ierr)
  call mpi_comm_rank(mpi_comm_world, rank, ierr)

  call mpi_get_address(bar, addr0)
  call mpi_get_address(bar%x, displs(1))
  call mpi_get_address(bar%i, displs(2))
  do i=1,2
     displs(i)=displs(i)-addr0
  enddo

  call mpi_type_create_struct(2,blocklengths,displs,types,mpi_bar_type,ierr)
  call mpi_type_commit(mpi_bar_type,ierr)

  bararray(:)%x=rank
  bararray(:)%i=rank
  test(:)=rank
  call mpi_bcast(test, 4, mpi_integer, 0, mpi_comm_world,ierr)
  call mpi_bcast(bararray, 4, mpi_bar_type, 0, mpi_comm_world,ierr)

  call mpi_finalize(ierr)

end program foo

I get a segfault at the derived type Bcast (with intelMPI and openMPI), an in a debugger (DDT), it is said that this might be an alignment problem...

I already saw this thread, where the problem seems to be the same, but I have still got no solution...

Thanks for helping!

回答1:

Just try this:

program foo
  implicit none
  include 'mpif.h'

  type bartype
     real(8) :: x
     integer :: i
  end type bartype

  integer :: mpi_bar_type

  integer ::                            &
       count=4,                         &
       blocklengths(4)=(/1,1,1,1/),      &
       types(4)=(/MPI_LB,mpi_double_precision, &
                  mpi_integer,MPI_UB/)
  integer(kind=mpi_address_kind) :: displs(4)
  type(bartype) :: bararray(4)
  integer :: rank, ierr, i, test(4)


  call mpi_init(ierr)
  call mpi_comm_rank(mpi_comm_world, rank, ierr)

  call mpi_get_address(bararray(1), displs(1))
  call mpi_get_address(bararray(1)%x, displs(2))
  call mpi_get_address(bararray(1)%i, displs(3))
  call mpi_get_address(bararray(2), displs(4))

  do i=4,1,-1
     displs(i)=displs(i)-displs(1)
  enddo

  call mpi_type_create_struct(4,blocklengths,displs,types,mpi_bar_type,ierr)
  call mpi_type_commit(mpi_bar_type,ierr)

  bararray(:)%x=rank
  bararray(:)%i=rank
  test(:)=rank
  print *, "before", bararray

  call mpi_bcast(test, 4, mpi_integer, 0, mpi_comm_world,ierr)
  call mpi_bcast(bararray, 4, mpi_bar_type, 0, mpi_comm_world,ierr)

  print *, "after", bararray

  call mpi_finalize(ierr)

end program foo

Note the use of MPI_LB and MPI_UB as additional fictitious members of the structure. This is to ensure that the extents of the type is right. I'm not entirely sure this is the recommended way for doing that according to the standard, but it has always worked for me. For what I know, the standard says to add a bind(C) and a sequence to your type definition, but even though, I'm not sure not setting the upper bound of the type would work since you will have alignment issue I suspect.

---

EDIT: after the various remarks about MPI_LB and MPI_UB which are indeed deprecated, and a careful re-reading of the standard, I guess the following works and should be compliant.

program foo
  implicit none
  include 'mpif.h'

  type bartype
     real(8) :: x
     integer :: i
  end type bartype

  integer :: tmp_type, bar_type

  integer ::                            &
       count=4,                         &
       blocklengths(2)=(/1,1/),         &
       types(2)=(/mpi_double_precision, &
                  mpi_integer/)
  integer(kind=mpi_address_kind) :: displs(2), lb, extent
  type(bartype) :: bararray(4)
  integer :: rank, ierr, i, test(4)


  call mpi_init(ierr)
  call mpi_comm_rank(mpi_comm_world, rank, ierr)

  call mpi_get_address(bararray(1)%x, displs(1))
  call mpi_get_address(bararray(1)%i, displs(2))
  call mpi_get_address(bararray(1), lb)
  call mpi_get_address(bararray(2), extent)

  do i=1,2
     displs(i)=displs(i)-lb
  enddo
  extent=extent-lb
  lb=0

  call mpi_type_create_struct(2,blocklengths,displs,types,tmp_type,ierr)
  call mpi_type_commit(tmp_type,ierr)
  call mpi_type_create_resized(tmp_type,lb,extent,bar_type,ierr)
  call mpi_type_free(tmp_type,ierr)
  call mpi_type_commit(bar_type,ierr)

  bararray(:)%x=rank
  bararray(:)%i=rank
  test(:)=rank
  print *, "before", bararray

  call mpi_bcast(test, 4, mpi_integer, 0, mpi_comm_world,ierr)
  call mpi_bcast(bararray, 4, bar_type, 0, mpi_comm_world,ierr)

  print *, "after", bararray

  call mpi_type_free(bar_type,ierr)
  call mpi_finalize(ierr)

end program foo