appending a sorted list of values to the dynamic array
with this subroutine, a given list of sorted values can be added to the dynamic array. the actual positions of these values in the dynamic array will be returned, so it can be found again easily later. with the wasadded flag, it is indicated,\n wasadded = true, if this entry had to be added,\n wasadded = false, if this was already found in the array.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dyn_realarray_type) | :: | me | ||||
| real(kind=rk), | intent(in) | :: | val(:) | |||
| integer, | intent(in), | optional | :: | length |
optional length to expand the array |
|
| integer, | intent(out), | optional | :: | pos(:) |
position in the array, the values are found at. |
|
| logical, | intent(out), | optional | :: | wasadded(:) |
flag to indicate, if val was newly added |
subroutine append_da_vecreal(me, val, length, pos, wasadded )
!------------------------------------------------------------------------
type(dyn_realarray_type) :: me !< array to append the value to
real(kind=rk), intent(in) :: val(:) !< values to append
!> optional length to expand the array
integer, intent(in), optional :: length
!> position in the array, the values are found at.
integer, intent(out), optional :: pos(:)
!> flag to indicate, if val was newly added
logical, intent(out), optional :: wasadded(:)
!------------------------------------------------------------------------
real(kind=rk) :: lastval
logical :: addedval(size(val))
integer :: i
integer :: veclen
integer :: maxlen
integer :: nappend
integer :: rem_app
integer :: curval, ival, iold, iadd
integer, allocatable :: newsorted(:)
!------------------------------------------------------------------------
if (size(val) == 0) return
veclen = size(val)
maxlen = veclen + me%nvals
allocate(newsorted(maxlen))
addedval = .false.
iold = 1
iadd = 1
nappend = 0
curval = 0
! select the first entry before the loop unconditionally without checks
! for uniqueness (nothing to check against yet).
if ( me%val(me%sorted(iold)) <= val(iadd) ) then
curval = curval + 1
newsorted(curval) = me%sorted(iold)
lastval = me%val(me%sorted(iold))
iold = iold + 1
else
curval = curval + 1
nappend = nappend + 1
newsorted(curval) = me%nvals + nappend
lastval = val(iadd)
if (present(pos)) pos(iadd) = newsorted(curval)
addedval(iadd) = .true.
iadd = iadd + 1
end if
do ival=2,maxlen
if ( (iadd <= veclen) .and. (iold <= me%nvals) ) then
if ( me%val(me%sorted(iold)) <= val(iadd) ) then
! the original list's values are appended to newsorted before
! the additional list is appended.
curval = curval + 1
newsorted(curval) = me%sorted(iold)
lastval = me%val(me%sorted(iold))
iold = iold + 1
else
! only append the value to unique lists, if it is not yet in the list.
! (if it is already in the list, it has to be the previous (curval-1)
! entry.)
if ( lastval < val(iadd) ) then
nappend = nappend + 1
curval = curval + 1
newsorted(curval) = me%nvals + nappend
lastval = val(iadd)
addedval(iadd) = .true.
end if
if (present(pos)) pos(iadd) = newsorted(curval)
iadd = iadd + 1
end if
else
! reached the end of one or both of the sorted lists.
exit
end if
end do
if (iold <= me%nvals) then
! still some values from the original list left.
newsorted(curval+1:me%nvals+nappend) = me%sorted(iold:me%nvals)
end if
if (iadd <= veclen) then
! still some values from the list to append left.
rem_app = iadd
do i = rem_app,veclen
if ( lastval < val(iadd) ) then
nappend = nappend + 1
curval = curval + 1
newsorted(curval) = me%nvals + nappend
lastval = val(iadd)
addedval(iadd) = .true.
end if
if (present(pos)) pos(iadd) = newsorted(curval)
iadd = iadd + 1
end do
end if
if (me%nvals > huge(me%nvals)-nappend) then
write(*,*) "reached end of integer range for dynamic array!"
write(*,*) "aborting!!"
stop
end if
if (me%nvals + nappend > me%containersize) then
call expand( me = me, &
& increment = nappend, &
& length = length )
end if
me%sorted(:me%nvals+nappend) = newsorted(:me%nvals+nappend)
curval = me%nvals
do iadd=1,veclen
if (addedval(iadd)) then
curval = curval + 1
me%val(curval) = val(iadd)
end if
end do
me%nvals = me%nvals + nappend
if( present( wasadded ) ) wasadded = addedval
end subroutine append_da_vecreal