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