Calculates the checksum of a DBCSR matrix.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_type), | intent(in) | :: | matrix |
matrix |
||
| logical, | intent(in), | optional | :: | local |
no global communication position-dependent checksum |
|
| logical, | intent(in), | optional | :: | pos |
no global communication position-dependent checksum |
calculated checksum
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