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