dbcsr_index_compact Subroutine

   SUBROUTINE dbcsr_index_compact(matrix)
      !! Compacts an index.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! matrix for which to make canonical index

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_index_compact'

      INTEGER                                            :: error_handle, new_size, size_blk_p, &
                                                            size_col_i, size_coo_l, size_row_p, &
                                                            size_thr_c
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: blk_p, col_i, coo_l, meta, row_p, thr_c
      LOGICAL                                            :: compact, has_blk_p, has_col_i, &
                                                            has_coo_l, has_row_p, has_thr_c

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, error_handle)
      ! Ensures the index pointers are set.
      CALL dbcsr_repoint_index(matrix)
      ! Check that compaction is even needed.
      has_row_p = ASSOCIATED(matrix%row_p)
      IF (has_row_p) THEN
         size_row_p = SIZE(matrix%row_p)
      ELSE
         size_row_p = 0
      END IF
      has_col_i = ASSOCIATED(matrix%col_i)
      IF (has_col_i) THEN
         size_col_i = SIZE(matrix%col_i)
      ELSE
         size_col_i = 0
      END IF
      has_blk_p = ASSOCIATED(matrix%blk_p)
      IF (has_blk_p) THEN
         size_blk_p = SIZE(matrix%blk_p)
      ELSE
         size_blk_p = 0
      END IF
      has_thr_c = ASSOCIATED(matrix%thr_c)
      IF (has_thr_c) THEN
         size_thr_c = SIZE(matrix%thr_c)
      ELSE
         size_thr_c = 0
      END IF
      has_coo_l = ASSOCIATED(matrix%coo_l)
      IF (has_coo_l) THEN
         size_coo_l = SIZE(matrix%coo_l)
      ELSE
         size_coo_l = 0
      END IF
      !
      new_size = dbcsr_num_slots + &
                 size_row_p + size_col_i + size_blk_p + size_thr_c + size_coo_l
      compact = new_size .LT. SIZE(matrix%index)
      IF (compact) THEN
         ! Store old index arrays.
         IF (has_row_p) THEN
            ALLOCATE (row_p(size_row_p))
            row_p(:) = matrix%row_p(:)
         END IF
         IF (has_col_i) THEN
            ALLOCATE (col_i(size_col_i))
            col_i(:) = matrix%col_i(:)
         END IF
         IF (has_blk_p) THEN
            ALLOCATE (blk_p(size_blk_p))
            blk_p(:) = matrix%blk_p(:)
         END IF
         IF (has_thr_c) THEN
            ALLOCATE (thr_c(size_thr_c))
            thr_c(:) = matrix%thr_c(:)
         END IF
         IF (has_coo_l) THEN
            ALLOCATE (coo_l(size_coo_l))
            coo_l(:) = matrix%coo_l(:)
         END IF
         ALLOCATE (meta(dbcsr_num_slots))
         meta(:) = matrix%index(1:dbcsr_num_slots)
         ! Clear the index.
         CALL memory_deallocate(matrix%index, &
                                dbcsr_get_index_memory_type(matrix))
         NULLIFY (matrix%index)
         CALL memory_allocate(matrix%index, new_size, &
                              dbcsr_get_index_memory_type(matrix))
         !
         ! Now copy the old index arrays into the index. We must not
         ! copy the positions of the old pointers.
         matrix%index(1:dbcsr_meta_size) = meta(1:dbcsr_meta_size)
         matrix%index(dbcsr_meta_size + 1:) = 0
         matrix%index(dbcsr_slot_size) = dbcsr_num_slots
         IF (has_thr_c) THEN
            CALL dbcsr_addto_index_array(matrix, dbcsr_slot_thr_c, thr_c)
            DEALLOCATE (thr_c)
         END IF
         IF (has_row_p) THEN
            CALL dbcsr_addto_index_array(matrix, dbcsr_slot_row_p, row_p)
            DEALLOCATE (row_p)
         END IF
         IF (has_col_i) THEN
            CALL dbcsr_addto_index_array(matrix, dbcsr_slot_col_i, col_i)
            DEALLOCATE (col_i)
         END IF
         IF (has_blk_p) THEN
            CALL dbcsr_addto_index_array(matrix, dbcsr_slot_blk_p, blk_p)
            DEALLOCATE (blk_p)
         END IF
         IF (has_coo_l) THEN
            CALL dbcsr_addto_index_array(matrix, dbcsr_slot_coo_l, coo_l)
            DEALLOCATE (coo_l)
         END IF
         DEALLOCATE (meta)
         IF (careful_mod) THEN
            ! This is pretty strong but it should be true.
            IF (matrix%index(dbcsr_slot_size) /= new_size) &
               DBCSR_ABORT("Unexpected index size.")
            IF (SIZE(matrix%index) /= new_size) &
               DBCSR_ABORT("Unexpected index size.")
         END IF
         CALL dbcsr_repoint_index(matrix)
      END IF
      CALL timestop(error_handle)
   END SUBROUTINE dbcsr_index_compact