Removes the deleted blocks from the index.
Description
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
Prune the index of this matrix. |
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