Apply filtering threshold eps to DBCSR blocks in order to improve CSR sparsity (currently only used for testing purposes)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | dbcsr_mat | |||
type(dbcsr_type), | intent(out) | :: | csr_sparsity | |||
real(kind=real_8), | intent(in) | :: | eps |
SUBROUTINE dbcsr_to_csr_filter(dbcsr_mat, csr_sparsity, eps)
!! Apply filtering threshold eps to DBCSR blocks in order to improve
!! CSR sparsity (currently only used for testing purposes)
TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
TYPE(dbcsr_type), INTENT(OUT) :: csr_sparsity
REAL(kind=real_8), INTENT(IN) :: eps
INTEGER :: blkcol, blkrow, col_blk_size, data_type, &
row_blk_size
LOGICAL :: tr
REAL(kind=real_8), ALLOCATABLE, DIMENSION(:) :: block_abs, csr_sparsity_blk
TYPE(dbcsr_data_obj) :: block
TYPE(dbcsr_iterator) :: iter
!REAL(kind=real_8), DIMENSION(:), POINTER :: block
CALL dbcsr_create(csr_sparsity, &
template=dbcsr_mat, &
name="CSR sparsity", &
data_type=dbcsr_type_real_8)
CALL dbcsr_copy(csr_sparsity, dbcsr_mat)
CALL dbcsr_set(csr_sparsity, 1.0_dp)
IF (eps .GT. 0.0_dp) THEN
data_type = dbcsr_get_data_type(dbcsr_mat)
CALL dbcsr_data_init(block)
CALL dbcsr_data_new(block, data_type)
CALL dbcsr_iterator_start(iter, dbcsr_mat, read_only=.TRUE.)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, blkrow, blkcol, block, transposed=tr, &
row_size=row_blk_size, col_size=col_blk_size)
ALLOCATE (block_abs(row_blk_size*col_blk_size))
ALLOCATE (csr_sparsity_blk(row_blk_size*col_blk_size))
SELECT CASE (data_type)
CASE (dbcsr_type_real_4)
block_abs(:) = REAL(ABS(block%d%r_sp(:)), KIND=real_8)
CASE (dbcsr_type_real_8)
block_abs(:) = REAL(ABS(block%d%r_dp(:)), KIND=real_8)
CASE (dbcsr_type_complex_4)
block_abs(:) = REAL(ABS(block%d%c_sp(:)), KIND=real_8)
CASE (dbcsr_type_complex_8)
block_abs(:) = REAL(ABS(block%d%c_dp(:)), KIND=real_8)
END SELECT
csr_sparsity_blk = 1.0_dp
WHERE (block_abs .LT. eps) csr_sparsity_blk = 0.0_dp
CALL dbcsr_put_block(csr_sparsity, blkrow, blkcol, csr_sparsity_blk, transposed=tr)
DEALLOCATE (csr_sparsity_blk, block_abs)
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_data_clear_pointer(block)
CALL dbcsr_data_release(block)
END IF
END SUBROUTINE dbcsr_to_csr_filter