dbcsr_print_block_sum Subroutine

public subroutine dbcsr_print_block_sum(matrix, unit_nr)

Prints the sum of the elements for each block

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(in) :: matrix

matrix

integer, intent(in), optional :: unit_nr

Contents

Source Code


Source Code

   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