Sorts index for recursing.
History - 2011-02-17 [UB] modified for use in DBCSR; reduced memory usage.
Always cut longest first. On a tie cut N
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | mi | |||
integer, | intent(in) | :: | mf | |||
integer, | intent(in) | :: | ni | |||
integer, | intent(in) | :: | nf | |||
integer, | intent(in) | :: | nele | |||
integer, | intent(inout), | DIMENSION(3, 1:nele) | :: | a | ||
integer, | intent(in) | :: | d |
RECURSIVE SUBROUTINE rec_sort_index(mi, mf, ni, nf, nele, a, d)
!! Sorts index for recursing.
!!
!! History
!! - 2011-02-17 [UB] modified for use in DBCSR; reduced memory usage.
!! @note Always cut longest first. On a tie cut N
INTEGER, INTENT(IN) :: mi, mf, ni, nf, nele
INTEGER, DIMENSION(3, 1:nele), INTENT(inout) :: a
INTEGER, INTENT(IN) :: d
LOGICAL, PARAMETER :: dbg = .FALSE.
INTEGER :: half, M, N, nlow
INTEGER, ALLOCATABLE, DIMENSION(:, :) :: tmp
! ---------------------------------------------------------------------------
IF (dbg) THEN
WRITE (*, *) " rs", mi, mf, "/", ni, nf, "=>", nele, d
WRITE (*, '(3(1X,I7))') a(:, 1:nele)
END IF
IF (dbg) THEN
IF (d .GT. 20) THEN
WRITE (*, *) a(1, -d*1000)
END IF
END IF
ALLOCATE (tmp(3, nele))
M = mf - mi + 1
N = nf - ni + 1
IF (M > N) THEN
half = M/2
CALL rec_split(nele, a, tmp, 1, nlow, mi, half)
a = tmp
DEALLOCATE (tmp)
IF (nlow .GT. 1) THEN
CALL rec_sort_index(mi, mi + half - 1, ni, nf, nlow, a(:, 1:nlow), d + 1)
END IF
IF (nele - nlow .GT. 1) THEN
CALL rec_sort_index(mi + half, mf, ni, nf, nele - nlow, a(:, nlow + 1:nele), d + 1)
END IF
ELSE
half = N/2
CALL rec_split(nele, a, tmp, 2, nlow, ni, half)
a = tmp
DEALLOCATE (tmp)
IF (nlow .GT. 1) THEN
CALL rec_sort_index(mi, mf, ni, ni + half - 1, nlow, a(:, 1:nlow), d + 1)
END IF
IF (nele - nlow .GT. 1) THEN
CALL rec_sort_index(mi, mf, ni + half, nf, nele - nlow, a(:, nlow + 1:nele), d + 1)
END IF
END IF
END SUBROUTINE rec_sort_index