dbcsr_index_prune_deleted Subroutine

   SUBROUTINE dbcsr_index_prune_deleted(matrix)
      !! Removes the deleted blocks from the index.
      !!
      !! Description

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! Prune the index of this matrix.

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

      INTEGER                                            :: error_handle, nblks_max, new_blk, nrows, &
                                                            old_blk, row
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: new_blk_p, new_col_i, new_row_count
      INTEGER, DIMENSION(:), POINTER                     :: old_blk_p, old_col_i, old_row_p

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

      CALL timeset(routineN, error_handle)
      !
      old_row_p => matrix%row_p
      old_col_i => matrix%col_i
      old_blk_p => matrix%blk_p
      !
      nrows = matrix%nblkrows_total
      nblks_max = old_row_p(nrows + 1)
      ALLOCATE (new_row_count(nrows))
      ALLOCATE (new_col_i(nblks_max))
      ALLOCATE (new_blk_p(nblks_max))
      !
      ! Build up the new index from all non-deleted blocks in the
      ! existing index.
      new_blk = 0
      DO row = 1, nrows
         new_row_count(row) = 0
         DO old_blk = old_row_p(row) + 1, old_row_p(row + 1)
            IF (old_blk_p(old_blk) .GT. 0) THEN
               new_blk = new_blk + 1
               new_row_count(row) = new_row_count(row) + 1
               new_col_i(new_blk) = old_col_i(old_blk)
               new_blk_p(new_blk) = old_blk_p(old_blk)
            END IF
         END DO
      END DO
      !
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_row_p)
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_col_i)
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_blk_p)
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_row_p, &
                                   reservation=nrows + 1, extra=2*new_blk)
      old_row_p => matrix%row_p
      CALL dbcsr_build_row_index(counts=new_row_count, rows=old_row_p, &
                                 nrows=nrows)
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_col_i, DATA=new_col_i(1:new_blk))
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_blk_p, DATA=new_blk_p(1:new_blk))
      matrix%nblks = new_blk
      matrix%index(dbcsr_slot_nblks) = new_blk
      !
      DEALLOCATE (new_col_i, new_blk_p, new_row_count)
      !
      CALL timestop(error_handle)
   END SUBROUTINE dbcsr_index_prune_deleted