tem_commbuf_real_gatherindexed Subroutine

private subroutine tem_commbuf_real_gatherindexed(me, pos, nvals)

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.

Arguments

Type IntentOptional Attributes Name
type(tem_realbuffer_type), intent(inout) :: me
integer, intent(in) :: pos(nvals)
integer, intent(in) :: nvals

Source Code

  subroutine tem_commbuf_real_gatherindexed( me, pos, nvals )
    ! -------------------------------------------------------------------- !
    type(tem_realbuffer_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, &
      &                    rk_mpi, me%memindexed, ierror     )
    call check_mpi_error(ierror,'type indexed in tem_commbuf_real_gatherindexed')
    call mpi_type_commit(me%memindexed, ierror)
    call check_mpi_error(ierror,'commit memindexed in tem_commbuf_real_gatherindexed')

    call destroy(displ)
    call destroy(blocklength)

  end subroutine tem_commbuf_real_gatherindexed