dbcsr_get_block_diag Subroutine

public subroutine dbcsr_get_block_diag(matrix, diag)

get the diagonal of a dbcsr matrix

Arguments

Type IntentOptional Attributes Name
type(dbcsr_type), intent(in) :: matrix

the matrix

type(dbcsr_type), intent(inout) :: diag

the diagonal


Source Code

   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