Impose sparsity on a dense matrix based on a dbcsr
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | sparse |
sparse matrix |
||
type(dbcsr_data_obj), | intent(inout) | :: | dense |
dense matrix Take into account the symmetry of the sparse matrix. The dense matrix need to be valid. The operation is done locally. |
SUBROUTINE dbcsr_impose_sparsity(sparse, dense)
!! Impose sparsity on a dense matrix based on a dbcsr
TYPE(dbcsr_type), INTENT(IN) :: sparse
!! sparse matrix
TYPE(dbcsr_data_obj), INTENT(inout) :: dense
!! dense matrix Take into account the symmetry of the sparse matrix. The dense matrix need to be valid. The operation is
!! done locally.
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_impose_sparsity'
CHARACTER :: symm
INTEGER :: blk, col, col_offset, col_size, &
data_type, dense_col_size, &
dense_row_size, handle, row, &
row_offset, row_size
LOGICAL :: valid
TYPE(dbcsr_data_obj) :: tmp
TYPE(dbcsr_iterator) :: iter
CALL timeset(routineN, handle)
CALL dbcsr_data_get_sizes(dense, dense_row_size, dense_col_size, valid)
IF (.NOT. valid) &
DBCSR_ABORT("dense matrix not valid")
data_type = dbcsr_data_get_type(dense)
symm = dbcsr_get_matrix_type(sparse)
CALL dbcsr_data_init(tmp)
CALL dbcsr_data_new(tmp, dbcsr_type_1d_to_2d(data_type), data_size=dense_row_size, &
data_size2=dense_col_size)
CALL dbcsr_data_set(dst=tmp, lb=1, data_size=dense_row_size, src=dense, source_lb=1, &
lb2=1, data_size2=dense_col_size, source_lb2=1)
CALL dbcsr_data_clear(dense)
CALL dbcsr_iterator_start(iter, sparse)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, blk, &
row_size=row_size, col_size=col_size, &
row_offset=row_offset, col_offset=col_offset)
CALL dbcsr_block_partial_copy( &
dst=dense, &
dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.FALSE., &
dst_r_lb=row_offset, dst_c_lb=col_offset, &
src=tmp, &
src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
src_r_lb=row_offset, src_c_lb=col_offset, &
nrow=row_size, ncol=col_size)
IF (symm .NE. dbcsr_type_no_symmetry) THEN
SELECT CASE (symm)
CASE (dbcsr_type_symmetric)
CALL dbcsr_block_partial_copy( &
dst=dense, &
dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
dst_r_lb=row_offset, dst_c_lb=col_offset, &
src=tmp, &
src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
src_r_lb=row_offset, src_c_lb=col_offset, &
nrow=row_size, ncol=col_size)
CASE (dbcsr_type_antisymmetric)
CALL dbcsr_block_partial_copy( &
dst=dense, &
dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
dst_r_lb=row_offset, dst_c_lb=col_offset, &
src=tmp, &
src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
src_r_lb=row_offset, src_c_lb=col_offset, &
nrow=row_size, ncol=col_size)
CALL dbcsr_block_scale(dense, dbcsr_scalar_negative(dbcsr_scalar_one( &
dbcsr_type_2d_to_1d(data_type))), &
row_size=col_size, col_size=row_size, &
lb=col_offset, lb2=row_offset)
CASE (dbcsr_type_hermitian)
CALL dbcsr_block_partial_copy( &
dst=dense, &
dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
dst_r_lb=row_offset, dst_c_lb=col_offset, &
src=tmp, &
src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
src_r_lb=row_offset, src_c_lb=col_offset, &
nrow=row_size, ncol=col_size)
CALL dbcsr_block_conjg(dense, row_size=col_size, col_size=row_size, &
lb=col_offset, lb2=row_offset)
CASE (dbcsr_type_antihermitian)
CALL dbcsr_block_partial_copy( &
dst=dense, &
dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
dst_r_lb=row_offset, dst_c_lb=col_offset, &
src=tmp, &
src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
src_r_lb=row_offset, src_c_lb=col_offset, &
nrow=row_size, ncol=col_size)
CALL dbcsr_block_scale(dense, dbcsr_scalar_negative(dbcsr_scalar_one( &
dbcsr_type_2d_to_1d(data_type))), &
row_size=col_size, col_size=row_size, &
lb=col_offset, lb2=row_offset)
CALL dbcsr_block_conjg(dense, row_size=col_size, col_size=row_size, &
lb=col_offset, lb2=row_offset)
CASE DEFAULT
DBCSR_ABORT("wrong matrix symmetry")
END SELECT
END IF
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_data_release(tmp)
CALL timestop(handle)
END SUBROUTINE dbcsr_impose_sparsity