dbcsr_checksum Function

   FUNCTION dbcsr_checksum(matrix, local, pos) RESULT(checksum)
      !! Calculates the checksum of a DBCSR matrix.

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix
      LOGICAL, INTENT(IN), OPTIONAL                      :: local, pos
         !! no global communication
         !! position-dependent checksum
      REAL(KIND=dp)                                      :: checksum
         !! calculated checksum

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_checksum'
      COMPLEX(KIND=real_4), DIMENSION(:), POINTER        :: c_sp
      COMPLEX(KIND=real_8), DIMENSION(:), POINTER        :: c_dp
      INTEGER                                            :: bc, blk, blk_p, br, co, handle, m, mn, &
                                                            n, ro
      INTEGER, DIMENSION(:), POINTER                     :: col_blk_size, row_blk_size
      LOGICAL                                            :: nocomm, pd, tr
      REAL(KIND=dp)                                      :: blk_cs, local_cs, local_cs_row
      REAL(KIND=real_4), DIMENSION(:), POINTER           :: r_sp
      REAL(KIND=real_8), DIMENSION(:), POINTER           :: r_dp

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      IF (.NOT. dbcsr_valid_index(matrix)) &
         DBCSR_ABORT("Invalid matrix.")
      nocomm = .FALSE.
      IF (PRESENT(local)) nocomm = local
      IF (PRESENT(pos)) THEN
         pd = pos
      ELSE
         pd = .FALSE.
      END IF
      row_blk_size => array_data(matrix%row_blk_size)
      col_blk_size => array_data(matrix%col_blk_size)
      local_cs = 0.0_dp
      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
      DO br = 1, matrix%nblkrows_total
         m = row_blk_size(br)
         ro = dbcsr_blk_row_offset(matrix, br)
         local_cs_row = 0
!$OMP        PARALLEL DO DEFAULT(NONE) &
!$OMP                 PRIVATE(bc,m,n,mn,blk_p,blk_cs,tr,co) &
!$OMP                 SHARED(pd,br,matrix,ro,row_blk_size,col_blk_size,r_dp, r_sp, c_dp,c_sp) &
!$OMP                  REDUCTION(+:local_cs_row)
         DO blk = matrix%row_p(br) + 1, matrix%row_p(br + 1)
            bc = matrix%col_i(blk)
            m = row_blk_size(br)
            n = col_blk_size(bc)
            mn = m*n
            blk_p = ABS(matrix%blk_p(blk))
            tr = matrix%blk_p(blk) .LT. 0
            IF (blk_p .NE. 0) THEN
               IF (mn .GT. 0) THEN
                  IF (tr) CALL swap(m, n)
                  co = dbcsr_blk_col_offset(matrix, bc)
                  ! Calculate DDOT
                  SELECT CASE (matrix%data_type)
                  CASE (dbcsr_type_real_8)
                     IF (pd) THEN
                        blk_cs = pd_blk_cs(m, n, r_dp(blk_p:blk_p + mn - 1), &
                                           tr, ro, co)
                     ELSE
                        blk_cs = REAL(DOT_PRODUCT(r_dp(blk_p:blk_p + mn - 1), &
                                                  r_dp(blk_p:blk_p + mn - 1)), KIND=dp)
                     END IF
                  CASE (dbcsr_type_real_4)
                     IF (pd) THEN
                        blk_cs = pd_blk_cs(m, n, REAL(r_sp(blk_p:blk_p + mn - 1), KIND=dp), &
                                           tr, ro, co)
                     ELSE
                        blk_cs = REAL(DOT_PRODUCT(r_sp(blk_p:blk_p + mn - 1), &
                                                  r_sp(blk_p:blk_p + mn - 1)), KIND=dp)
                     END IF
                  CASE (dbcsr_type_complex_8)
                     IF (pd) THEN
                        blk_cs = pd_blk_cs(m, n, REAL(c_dp(blk_p:blk_p + mn - 1), KIND=dp), &
                                           tr, ro, co)
                     ELSE
                        blk_cs = REAL(DOT_PRODUCT(c_dp(blk_p:blk_p + mn - 1), &
                                                  c_dp(blk_p:blk_p + mn - 1)), KIND=dp)
                     END IF
                  CASE (dbcsr_type_complex_4)
                     IF (pd) THEN
                        blk_cs = pd_blk_cs(m, n, REAL(c_sp(blk_p:blk_p + mn - 1), KIND=dp), &
                                           tr, ro, co)
                     ELSE
                        blk_cs = REAL(DOT_PRODUCT(c_sp(blk_p:blk_p + mn - 1), &
                                                  c_sp(blk_p:blk_p + mn - 1)), KIND=dp)
                     END IF
                  CASE default
                     blk_cs = 0.0_dp
                  END SELECT
               ELSE
                  blk_cs = 0.0_dp
               END IF
               local_cs_row = local_cs_row + blk_cs
            END IF
         END DO
         local_cs = local_cs + local_cs_row
      END DO
      checksum = local_cs
      IF (.NOT. nocomm) THEN
         CALL mp_sum(local_cs, dbcsr_mp_group(dbcsr_distribution_mp( &
                                              matrix%dist)))
         checksum = local_cs
      END IF
      CALL timestop(handle)
   END FUNCTION dbcsr_checksum