dbcsr_frobenius_norm Function

public function dbcsr_frobenius_norm(matrix, local) result(norm)

compute a norm of a dbcsr matrix

Arguments

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

the matrix

logical, intent(in), optional :: local

Return Value real(kind=real_8)


Source Code

   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