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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dyn_realarray_type) | :: | me | ||||
integer, | optional | :: | increment | |||
integer, | intent(in), | optional | :: | length |
optional length to expand the array |
subroutine expand_da_real(me, increment, length)
!------------------------------------------------------------------------
type(dyn_realarray_type) :: me !< array to resize
integer, optional :: increment !< used for vector append
!> optional length to expand the array
integer, intent(in), optional :: length
!------------------------------------------------------------------------
real(kind=rk), 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_real