compute a norm of a dbcsr matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix |
the matrix |
||
logical, | intent(in), | optional | :: | local |
FUNCTION dbcsr_frobenius_norm(matrix, local) RESULT(norm)
!! compute a norm of a dbcsr matrix
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! the matrix
LOGICAL, INTENT(in), OPTIONAL :: local
REAL(KIND=real_8) :: norm
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_frobenius_norm'
COMPLEX(KIND=real_4), DIMENSION(:, :), POINTER :: data_c
COMPLEX(KIND=real_8), DIMENSION(:, :), POINTER :: data_z
INTEGER :: blk, col, handle, row
LOGICAL :: any_sym, my_local, tr
REAL(KIND=real_4), DIMENSION(:, :), POINTER :: data_r
REAL(KIND=real_8), DIMENSION(:, :), POINTER :: data_d
REAL(real_8) :: fac
TYPE(dbcsr_iterator) :: iter
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
my_local = .FALSE.
IF (PRESENT(local)) my_local = local
any_sym = dbcsr_get_matrix_type(matrix) .EQ. dbcsr_type_symmetric .OR. &
dbcsr_get_matrix_type(matrix) .EQ. dbcsr_type_antisymmetric
norm = 0.0_dp
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
SELECT CASE (dbcsr_get_data_type(matrix))
CASE (dbcsr_type_real_4)
CALL dbcsr_iterator_next_block(iter, row, col, data_r, tr, blk)
fac = 1.0_dp
IF (any_sym .AND. row .NE. col) fac = 2.0_dp
norm = norm + fac*SUM(data_r**2)
CASE (dbcsr_type_real_8)
CALL dbcsr_iterator_next_block(iter, row, col, data_d, tr, blk)
fac = 1.0_dp
IF (any_sym .AND. row .NE. col) fac = 2.0_dp
norm = norm + fac*SUM(data_d**2)
CASE (dbcsr_type_complex_4)
CALL dbcsr_iterator_next_block(iter, row, col, data_c, tr, blk)
fac = 1.0_dp
IF (any_sym .AND. row .NE. col) &
DBCSR_ABORT("Only nonsymmetric matrix so far")
norm = norm + fac*REAL(SUM(CONJG(data_c)*data_c), KIND=real_8)
CASE (dbcsr_type_complex_8)
CALL dbcsr_iterator_next_block(iter, row, col, data_z, tr, blk)
fac = 1.0_dp
IF (any_sym .AND. row .NE. col) &
DBCSR_ABORT("Only nonsymmetric matrix so far")
norm = norm + fac*REAL(SUM(CONJG(data_z)*data_z), KIND=real_8)
CASE DEFAULT
DBCSR_ABORT("Wrong data type")
END SELECT
END DO
CALL dbcsr_iterator_stop(iter)
IF (.NOT. my_local) CALL mp_sum(norm, dbcsr_mp_group(dbcsr_distribution_mp(matrix%dist)))
norm = SQRT(norm)
CALL timestop(handle)
END FUNCTION dbcsr_frobenius_norm