rec_sort_index Subroutine

public 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

Arguments

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

Source Code

   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