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