Prints the sum of the elements for each block
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix |
matrix |
||
integer, | intent(in), | optional | :: | unit_nr |
SUBROUTINE dbcsr_print_block_sum(matrix, unit_nr) !! Prints the sum of the elements for each block TYPE(dbcsr_type), INTENT(IN) :: matrix !! matrix INTEGER, INTENT(IN), OPTIONAL :: unit_nr CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_print_block_sum' COMPLEX(KIND=real_4) :: blk_sum_c_sp COMPLEX(KIND=real_4), DIMENSION(:), POINTER :: c_sp COMPLEX(KIND=real_8) :: blk_sum_c_dp COMPLEX(KIND=real_8), DIMENSION(:), POINTER :: c_dp INTEGER :: bc, blk, blk_p, br, handle, iunit, m, & mn, n INTEGER, DIMENSION(:), POINTER :: col_blk_offset, col_blk_size, & row_blk_offset, row_blk_size REAL(KIND=real_4) :: blk_sum_r_sp REAL(KIND=real_4), DIMENSION(:), POINTER :: r_sp REAL(KIND=real_8) :: blk_sum_r_dp REAL(KIND=real_8), DIMENSION(:), POINTER :: r_dp ! --------------------------------------------------------------------------- CALL timeset(routineN, handle) IF (.NOT. dbcsr_valid_index(matrix)) & DBCSR_WARN("Can not print invalid matrix.") iunit = default_output_unit IF (PRESENT(unit_nr)) iunit = unit_nr IF (iunit > 0) THEN SELECT CASE (matrix%data_type) CASE (dbcsr_type_real_8) CALL dbcsr_get_data(matrix%data_area, r_dp) CASE (dbcsr_type_real_4) CALL dbcsr_get_data(matrix%data_area, r_sp) CASE (dbcsr_type_complex_8) CALL dbcsr_get_data(matrix%data_area, c_dp) CASE (dbcsr_type_complex_4) CALL dbcsr_get_data(matrix%data_area, c_sp) END SELECT row_blk_size => array_data(matrix%row_blk_size) col_blk_size => array_data(matrix%col_blk_size) row_blk_offset => array_data(matrix%row_blk_offset) col_blk_offset => array_data(matrix%col_blk_offset) IF (matrix%nblks .GT. 0) THEN DO br = 1, matrix%nblkrows_total m = row_blk_size(br) DO blk = matrix%row_p(br) + 1, matrix%row_p(br + 1) bc = matrix%col_i(blk) n = col_blk_size(bc) mn = m*n blk_p = ABS(matrix%blk_p(blk)) block_exists: IF (blk_p .NE. 0) THEN IF (mn .GT. 0) THEN SELECT CASE (matrix%data_type) CASE (dbcsr_type_real_8) blk_sum_r_dp = SUM(r_dp(blk_p:blk_p + mn - 1)) WRITE (iunit, '(I6,I6,ES18.9)') & br, bc, blk_sum_r_dp CASE (dbcsr_type_real_4) blk_sum_r_sp = SUM(r_sp(blk_p:blk_p + mn - 1)) WRITE (iunit, '(I6,I6,ES18.9)') & br, bc, blk_sum_r_sp CASE (dbcsr_type_complex_8) blk_sum_c_dp = SUM(c_dp(blk_p:blk_p + mn - 1)) WRITE (iunit, '(I6,I6,ES18.9," I*",ES18.9)') & br, bc, REAL(blk_sum_c_dp), AIMAG(blk_sum_c_dp) CASE (dbcsr_type_complex_4) blk_sum_c_sp = SUM(c_sp(blk_p:blk_p + mn - 1)) WRITE (iunit, '(I6,I6,ES18.9," I*",ES18.9)') & br, bc, REAL(blk_sum_c_sp), AIMAG(blk_sum_c_sp) END SELECT ELSE blk_sum_r_dp = 0.0_dp WRITE (iunit, '(I6,I6,ES18.9)') & br, bc, blk_sum_r_dp END IF END IF block_exists END DO END DO END IF END IF ! unit > 0 CALL timestop(handle) END SUBROUTINE dbcsr_print_block_sum