gather the indexed mpi datatype, which describes how the data in the state vector relates to the entries in the buffer. in contrast to the simple indexed type above, we try to minimize the number of blocks here, and gather contiguous blocks of memory together.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(tem_longbuffer_type), | intent(inout) | :: | me | |||
integer, | intent(in) | :: | pos(nvals) | |||
integer, | intent(in) | :: | nvals |
subroutine tem_commbuf_long_gatherindexed( me, pos, nvals )
! -------------------------------------------------------------------- !
type(tem_longbuffer_type), intent(inout) :: me
integer, intent(in) :: nvals
integer, intent(in) :: pos(nvals)
! -------------------------------------------------------------------- !
type(grw_intarray_type) :: blocklength
type(grw_intarray_type) :: displ
integer :: ival, counter
integer :: ierror
! -------------------------------------------------------------------- !
me%nvals = nvals
! initialize growing arrays, a kb should be fine to start with...
call init(blocklength, 256)
call init(displ, 256)
if (nvals > 0) then
! start with the displacement of the first entry in the list
call append(displ, pos(1)-1)
counter = 1
do ival=2,nvals
if (pos(ival) == pos(ival-1)+1) then
! contiguous memory location following the previous one, increase the
! the blocklength.
counter = counter + 1
else
! new block encountered, record the block found so far
call append(blocklength, counter)
! start new block
call append(displ, pos(ival)-1)
counter = 1
end if
end do
! finish the last block, by recording its found length:
call append(blocklength, counter)
end if
! call mpi_type_indexed(count, array_of_blocklengths, &
! & array_of_displacements, oldtype, newtype, ierror)
call mpi_type_indexed( displ%nvals, blocklength%val, displ%val, &
& long_k_mpi, me%memindexed, ierror )
call check_mpi_error(ierror,'type indexed in tem_commbuf_long_gatherindexed')
call mpi_type_commit(me%memindexed, ierror)
call check_mpi_error(ierror,'commit memindexed in tem_commbuf_long_gatherindexed')
call destroy(displ)
call destroy(blocklength)
end subroutine tem_commbuf_long_gatherindexed