expand_da_label Subroutine

public subroutine expand_da_label(me, increment, length)

expanding the dynamic array

this is a helping subroutine, which doubles the container of the given dynamic array. as the container might be initially 0-sized, a module variable minlength has been introduced, which is used here, to at least create a container of this size.

Arguments

Type IntentOptional Attributes Name
type(dyn_labelarray_type) :: me
integer, optional :: increment
integer, intent(in), optional :: length

optional length to expand the array

Called by

proc~~expand_da_label~~CalledByGraph proc~expand_da_label expand_da_label interface~expand~27 expand interface~expand~27->proc~expand_da_label proc~append_da_int append_da_int proc~append_da_int->interface~expand~27 proc~append_da_label append_da_label proc~append_da_label->interface~expand~27 proc~append_da_long append_da_long proc~append_da_long->interface~expand~27 proc~append_da_real append_da_real proc~append_da_real->interface~expand~27 proc~append_da_vecint append_da_vecint proc~append_da_vecint->interface~expand~27 proc~append_da_veclabel append_da_veclabel proc~append_da_veclabel->interface~expand~27 proc~append_da_veclong append_da_veclong proc~append_da_veclong->interface~expand~27 proc~append_da_vecreal append_da_vecreal proc~append_da_vecreal->interface~expand~27 interface~append~26 append interface~append~26->proc~append_da_long interface~append~26->proc~append_da_veclong interface~append~27 append interface~append~27->proc~append_da_int interface~append~27->proc~append_da_vecint interface~append~28 append interface~append~28->proc~append_da_real interface~append~28->proc~append_da_vecreal interface~append~29 append interface~append~29->proc~append_da_label interface~append~29->proc~append_da_veclabel

Source Code

  subroutine expand_da_label(me, increment, length)
    !------------------------------------------------------------------------
    type(dyn_labelarray_type) :: me !< array to resize
    integer, optional :: increment !< used for vector append
    !> optional length to expand the array
    integer, intent(in), optional :: length
    !------------------------------------------------------------------------
    character(len=labellen), allocatable :: swpval(:)
    integer, allocatable :: swpsort(:)
    !------------------------------------------------------------------------
    integer :: addvals, explen
    !------------------------------------------------------------------------

    addvals = 1
    if (present(increment)) addvals = increment

    if (addvals > 0) then

      ! if length is present, use that, otherwise double the size
      if( present( length ) ) then
        explen = length
      else
        ! set the global minimum length, if doubling would be smaller than that
        explen = max(me%containersize, minlength)
      end if

      ! check whether all elements will fit
      if( addvals > explen ) then
        explen = addvals
      end if

      ! check whether the new size will exceed the max container size.
      if( (huge(me%containersize) - explen) <= me%containersize ) then
        ! if so, expand to the maximum size
        me%containersize = huge(me%containersize)
      else
        ! if not, expand to the calculated size
        me%containersize = me%containersize + explen
      end if

      ! only need to do something, if there are actually values to append.
      if (me%nvals > 0) then

        allocate(swpval(me%containersize))
        swpval(1:me%nvals) = me%val(1:me%nvals)
        call move_alloc( swpval, me%val )

        allocate(swpsort(me%containersize))
        swpsort(1:me%nvals) = me%sorted(1:me%nvals)
        call move_alloc( swpsort, me%sorted )

      else ! me%nvals == 0

        if( allocated(me%val) ) &
          deallocate(me%val)
        allocate(me%val(me%containersize))
        if( allocated(me%sorted) ) &
          deallocate(me%sorted)
        allocate(me%sorted(me%containersize))

      end if

    end if

  end subroutine expand_da_label