get the diagonal of a dbcsr matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix |
the matrix |
||
type(dbcsr_type), | intent(inout) | :: | diag |
the diagonal |
SUBROUTINE dbcsr_get_block_diag(matrix, diag)
!! get the diagonal of a dbcsr matrix
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! the matrix
TYPE(dbcsr_type), INTENT(INOUT) :: diag
!! the diagonal
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_get_block_diag'
INTEGER :: blk, col, handle, row
LOGICAL :: tr
TYPE(dbcsr_data_obj) :: data_a
TYPE(dbcsr_iterator) :: iter
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
CALL dbcsr_create(diag, name='diag of '//TRIM(matrix%name), &
template=matrix)
CALL dbcsr_data_init(data_a)
CALL dbcsr_data_new(data_a, dbcsr_get_data_type(matrix))
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, data_a, tr, blk)
IF (row .EQ. col) CALL dbcsr_put_block(diag, row, col, data_a, transposed=tr)
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_data_clear_pointer(data_a)
CALL dbcsr_data_release(data_a)
CALL dbcsr_finalize(diag)
CALL timestop(handle)
END SUBROUTINE dbcsr_get_block_diag