The actual sort routine. Only dbcsr_1d_i4_sort and itself should call this.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=int_4), | intent(inout), | dimension(:) | :: | arr |
the array to sort |
|
integer, | intent(inout), | dimension(size(arr)) | :: | indices |
elements-indices before the sort |
|
integer(kind=int_4), | intent(inout), | dimension((size(arr) + 1)/2) | :: | tmp_arr |
scratch space |
|
integer, | intent(inout), | dimension((size(arr) + 1)/2) | :: | tmp_idx |
scratch space |
recursive subroutine dbcsr_1d_i4_sort_low(arr, indices, tmp_arr, tmp_idx)
!! The actual sort routine.
!! Only dbcsr_1d_i4_sort and itself should call this.
INTEGER(kind=int_4), dimension(:), intent(inout) :: arr
!! the array to sort
integer, dimension(size(arr)), intent(inout) :: indices
!! elements-indices before the sort
INTEGER(kind=int_4), dimension((size(arr) + 1)/2), intent(inout) :: tmp_arr
!! scratch space
integer, dimension((size(arr) + 1)/2), intent(inout) :: tmp_idx
!! scratch space
INTEGER(kind=int_4) :: a
integer :: t, m, i, j, k
LOGICAL :: swapped
! a,t: used during swapping of elements in arr and indices
swapped = .TRUE.
! If only a few elements are left we switch to bubble-sort for efficiency.
if (size(arr) <= 7) then ! 7 seems to be a good choice for the moment
DO j = size(arr) - 1, 1, -1
swapped = .FALSE.
DO i = 1, j
IF (arr(i+1) < arr(i)) THEN
! swap arr(i) with arr(i+1)
a = arr(i)
arr(i) = arr(i + 1)
arr(i + 1) = a
! swap indices(i) with indices(i+1)
t = indices(i)
indices(i) = indices(i + 1)
indices(i + 1) = t
swapped = .true.
END IF
END DO
IF (.NOT. swapped) EXIT
END DO
return
end if
! split list in half and recursively sort both sublists
m = (size(arr) + 1)/2 ! index where we going to divide the list in two
call dbcsr_1d_i4_sort_low(arr(1:m), indices(1:m), tmp_arr, tmp_idx)
call dbcsr_1d_i4_sort_low(arr(m + 1:), indices(m + 1:), tmp_arr, tmp_idx)
! Check for a special case: Can we just concatenate the two sorted sublists?
! This leads to O(n) scaling if the input is already sorted.
if (arr(m+1) < arr(m)) then
! ...no - let's merge the two sorted sublists arr(:m) and arr(m+1:)
! Merge will be performed directly in arr. Need backup of first sublist.
tmp_arr(1:m) = arr(1:m)
tmp_idx(1:m) = indices(1:m)
i = 1; ! number of elements consumed from 1st sublist
j = 1; ! number of elements consumed from 2nd sublist
k = 1; ! number of elements already merged
do while (i <= m .and. j <= size(arr) - m)
if (arr(m+j) < tmp_arr(i)) then
arr(k) = arr(m + j)
indices(k) = indices(m + j)
j = j + 1
else
arr(k) = tmp_arr(i)
indices(k) = tmp_idx(i)
i = i + 1
end if
k = k + 1
end do
! One of the two sublist is now empty.
! Copy possibly remaining tail of 1st sublist
do while (i <= m)
arr(k) = tmp_arr(i)
indices(k) = tmp_idx(i)
i = i + 1
k = k + 1
end do
! The possibly remaining tail of 2nd sublist is already at the right spot.
end if
end subroutine dbcsr_1d_i4_sort_low