compute the column norms of the dbcsr matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
the matrix |
||
integer, | intent(in) | :: | which_norm | |||
type(dbcsr_data_obj), | intent(inout) | :: | norm_vector |
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