Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(grw_spherearray_type) | :: | me | ||||
integer, | intent(in), | optional | :: | pos | ||
integer, | intent(in), | optional | :: | length |
optional length to expand the array |
subroutine expand_ga_sphere(me, pos, length)
type(grw_spherearray_type) :: me !< array to resize
integer, intent(in), optional :: pos !< optional predefined position
!> optional length to expand the array
integer, intent(in), optional :: length
type(tem_sphere_type), allocatable :: swpval(:)
integer :: explen, ii
explen = 0
! increase the container by the requested length of double it
if( present(length) ) then
explen = max( length, minlength )
else
! set the global minimum length, if doubling would be smaller than that
explen = max(me%containersize, minlength)
end if
! if a position is given, increase the container to at least the size to
! fit the position.
if( present(pos) ) explen = max(explen, pos-me%containersize)
! if the current size plus explen exceeds the max container size,
! reduce the size to the max container size.
if( (huge(me%containersize) - explen) <= me%containersize) then
! set max container size
me%containersize = huge(me%containersize)
else
! set the new container size
me%containersize = me%containersize + explen
end if
if ( me%nvals > 0 ) then
allocate(swpval(me%containersize))
do ii = 1, me%nvals
swpval(ii) = me%val(ii)
end do
call move_alloc( swpval, me%val )
else ! me%nvals == 0
if ( allocated(me%val) ) deallocate( me%val )
allocate( me%val(me%containersize) )
end if
end subroutine expand_ga_sphere