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
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