dbcsr_norm_vec Subroutine

private subroutine dbcsr_norm_vec(matrix, which_norm, norm_vector)

compute the column norms of the dbcsr matrix

Arguments

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

the matrix

integer, intent(in) :: which_norm
type(dbcsr_data_obj), intent(inout) :: norm_vector

Source Code

   SUBROUTINE dbcsr_norm_vec(matrix, which_norm, norm_vector)
      !! compute the column norms of the dbcsr matrix

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! the matrix
      INTEGER, INTENT(IN)                                :: which_norm
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: norm_vector

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_norm_vec'

      INTEGER                                            :: blk, col, col_offset, i, j, row, &
                                                            row_offset, handle
      LOGICAL                                            :: tr
      TYPE(dbcsr_data_obj)                               :: data_a
      TYPE(dbcsr_iterator)                               :: iter

      CALL timeset(routineN, handle)

      SELECT CASE (which_norm)
      CASE (dbcsr_norm_column)
         IF (dbcsr_data_get_type(norm_vector) /= dbcsr_get_data_type(matrix)) &
            DBCSR_ABORT("Mismatched vector/matrix data types")
         IF (dbcsr_has_symmetry(matrix)) THEN
            IF (dbcsr_data_get_size(norm_vector) < dbcsr_nfullrows_total(matrix)) &
               DBCSR_ABORT("Passed vector too small")
         END IF
         IF (dbcsr_data_get_size(norm_vector) < dbcsr_nfullcols_total(matrix)) &
            DBCSR_ABORT("Passed vector too small")
         CALL dbcsr_data_init(data_a)
         CALL dbcsr_data_new(data_a, dbcsr_type_1d_to_2d(dbcsr_get_data_type(matrix)))
         CALL dbcsr_data_clear(norm_vector)
         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, row_offset=row_offset, col_offset=col_offset)
            SELECT CASE (dbcsr_get_data_type(matrix))
            CASE (dbcsr_type_real_4)
               IF (dbcsr_has_symmetry(matrix) .AND. row .NE. col) THEN
                  DO j = 1, SIZE(data_a%d%r2_sp, 2)
                     DO i = 1, SIZE(data_a%d%r2_sp, 1)
                        norm_vector%d%r_sp(col_offset + j - 1) &
                           = norm_vector%d%r_sp(col_offset + j - 1) &
                             + data_a%d%r2_sp(i, j)**2
                        norm_vector%d%r_sp(row_offset + i - 1) &
                           = norm_vector%d%r_sp(row_offset + i - 1) &
                             + data_a%d%r2_sp(i, j)**2
                     END DO
                  END DO
               ELSE
                  DO j = 1, SIZE(data_a%d%r2_sp, 2)
                     DO i = 1, SIZE(data_a%d%r2_sp, 1)
                        norm_vector%d%r_sp(col_offset + j - 1) &
                           = norm_vector%d%r_sp(col_offset + j - 1) &
                             + data_a%d%r2_sp(i, j)*data_a%d%r2_sp(i, j)
                     END DO
                  END DO
               END IF
            CASE (dbcsr_type_real_8)
               IF (dbcsr_has_symmetry(matrix) .AND. row .NE. col) THEN
                  DO j = 1, SIZE(data_a%d%r2_dp, 2)
                     DO i = 1, SIZE(data_a%d%r2_dp, 1)
                        norm_vector%d%r_dp(col_offset + j - 1) &
                           = norm_vector%d%r_dp(col_offset + j - 1) &
                             + data_a%d%r2_dp(i, j)**2
                        norm_vector%d%r_dp(row_offset + i - 1) &
                           = norm_vector%d%r_dp(row_offset + i - 1) &
                             + data_a%d%r2_dp(i, j)**2
                     END DO
                  END DO
               ELSE
                  DO j = 1, SIZE(data_a%d%r2_dp, 2)
                     DO i = 1, SIZE(data_a%d%r2_dp, 1)
                        norm_vector%d%r_dp(col_offset + j - 1) &
                           = norm_vector%d%r_dp(col_offset + j - 1) &
                             + data_a%d%r2_dp(i, j)*data_a%d%r2_dp(i, j)
                     END DO
                  END DO
               END IF
            CASE DEFAULT
               DBCSR_ABORT("Only real values")
            END SELECT
         END DO
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_data_clear_pointer(data_a)
         CALL dbcsr_data_release(data_a)
         SELECT CASE (dbcsr_get_data_type(matrix))
         CASE (dbcsr_type_real_4)
            CALL mp_sum(norm_vector%d%r_sp, &
                        dbcsr_mp_group(dbcsr_distribution_mp(matrix%dist)))
            norm_vector%d%r_sp = SQRT(norm_vector%d%r_sp)
         CASE (dbcsr_type_real_8)
            CALL mp_sum(norm_vector%d%r_dp, &
                        dbcsr_mp_group(dbcsr_distribution_mp(matrix%dist)))
            norm_vector%d%r_dp = SQRT(norm_vector%d%r_dp)
         END SELECT

      CASE DEFAULT
         DBCSR_ABORT("this norm is NYI")
      END SELECT
      CALL timestop(handle)
   END SUBROUTINE dbcsr_norm_vec