Clears a data area
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_data_obj), | intent(inout) | :: | area |
area with encapsulated data |
||
| integer, | intent(in), | optional | :: | lb |
lower bound for clearing lower bound for clearing |
|
| integer, | intent(in), | optional | :: | ub |
lower bound for clearing lower bound for clearing |
|
| type(dbcsr_scalar_type), | intent(in), | optional | :: | value |
value to use for clearing |
|
| integer, | intent(in), | optional | :: | lb2 |
upper bound for clearing upper bound for clearing |
|
| integer, | intent(in), | optional | :: | ub2 |
upper bound for clearing upper bound for clearing |
SUBROUTINE dbcsr_data_clear0(area, lb, ub, value, lb2, ub2)
!! Clears a data area
TYPE(dbcsr_data_obj), INTENT(INOUT) :: area
!! area with encapsulated data
INTEGER, INTENT(IN), OPTIONAL :: lb, ub
!! lower bound for clearing
!! lower bound for clearing
TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL :: value
!! value to use for clearing
INTEGER, INTENT(IN), OPTIONAL :: lb2, ub2
!! upper bound for clearing
!! upper bound for clearing
INTEGER :: l, l2, s, u, u2
! ---------------------------------------------------------------------------
IF (.NOT. ASSOCIATED(area%d)) &
DBCSR_ABORT("Data area must be setup.")
IF (PRESENT(value)) THEN
IF (area%d%data_type .NE. value%data_type) &
DBCSR_ABORT("Incompatible data types")
END IF
l = 0
u = 0
SELECT CASE (area%d%data_type)
CASE (dbcsr_type_real_4)
l = LBOUND(area%d%r_sp, 1)
u = UBOUND(area%d%r_sp, 1)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(value)) THEN
area%d%r_sp(l:u) = value%r_sp
ELSE
area%d%r_sp(l:u) = 0.0_real_4
END IF
CASE (dbcsr_type_real_8)
l = LBOUND(area%d%r_dp, 1)
u = UBOUND(area%d%r_dp, 1)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(value)) THEN
area%d%r_dp(l:u) = value%r_dp
ELSE
area%d%r_dp(l:u) = 0.0_real_8
END IF
CASE (dbcsr_type_complex_4)
l = LBOUND(area%d%c_sp, 1)
u = UBOUND(area%d%c_sp, 1)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(value)) THEN
area%d%c_sp(l:u) = value%c_sp
ELSE
area%d%c_sp(l:u) = CMPLX(0.0, 0.0, real_4)
END IF
CASE (dbcsr_type_complex_8)
l = LBOUND(area%d%c_dp, 1)
u = UBOUND(area%d%c_dp, 1)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(value)) THEN
area%d%c_dp(l:u) = value%c_dp
ELSE
area%d%c_dp(l:u) = CMPLX(0.0, 0.0, real_8)
END IF
CASE (dbcsr_type_real_4_2d)
l = LBOUND(area%d%r2_sp, 1)
u = UBOUND(area%d%r2_sp, 1)
l2 = LBOUND(area%d%r2_sp, 2)
u2 = UBOUND(area%d%r2_sp, 2)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(lb2)) THEN
IF (lb2 < l2) DBCSR_ABORT("lower2 bound too low")
l2 = lb2
END IF
IF (PRESENT(ub2)) THEN
IF (ub2 > u2) DBCSR_ABORT("upper2 bound too high")
u2 = ub2
END IF
IF (PRESENT(value)) THEN
area%d%r2_sp(l:u, l2:u2) = value%r_sp
ELSE
area%d%r2_sp(l:u, l2:u2) = 0.0_real_4
END IF
CASE (dbcsr_type_real_8_2d)
l = LBOUND(area%d%r2_dp, 1)
u = UBOUND(area%d%r2_dp, 1)
l2 = LBOUND(area%d%r2_dp, 2)
u2 = UBOUND(area%d%r2_dp, 2)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(lb2)) THEN
IF (lb2 < l2) DBCSR_ABORT("lower2 bound too low")
l2 = lb2
END IF
IF (PRESENT(ub2)) THEN
IF (ub2 > u2) DBCSR_ABORT("upper2 bound too high")
u2 = ub2
END IF
IF (PRESENT(value)) THEN
area%d%r2_dp(l:u, l2:u2) = value%r_dp
ELSE
area%d%r2_dp(l:u, l2:u2) = 0.0_real_8
END IF
CASE (dbcsr_type_complex_4_2d)
l = LBOUND(area%d%c2_sp, 1)
u = UBOUND(area%d%c2_sp, 1)
l2 = LBOUND(area%d%c2_sp, 2)
u2 = UBOUND(area%d%c2_sp, 2)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(lb2)) THEN
IF (lb2 < l2) DBCSR_ABORT("lower2 bound too low")
l2 = lb2
END IF
IF (PRESENT(ub2)) THEN
IF (ub2 > u2) DBCSR_ABORT("upper2 bound too high")
u2 = ub2
END IF
IF (PRESENT(value)) THEN
area%d%c2_sp(l:u, l2:u2) = value%c_sp
ELSE
area%d%c2_sp(l:u, l2:u2) = CMPLX(0.0, 0.0, real_4)
END IF
CASE (dbcsr_type_complex_8_2d)
l = LBOUND(area%d%c2_dp, 1)
u = UBOUND(area%d%c2_dp, 1)
l2 = LBOUND(area%d%c2_dp, 2)
u2 = UBOUND(area%d%c2_dp, 2)
IF (PRESENT(lb)) THEN
IF (lb < l) DBCSR_ABORT("lower bound too low")
l = lb
END IF
IF (PRESENT(ub)) THEN
IF (ub > u) DBCSR_ABORT("upper bound too high")
u = ub
END IF
IF (PRESENT(lb2)) THEN
IF (lb2 < l2) DBCSR_ABORT("lower2 bound too low")
l2 = lb2
END IF
IF (PRESENT(ub2)) THEN
IF (ub2 > u2) DBCSR_ABORT("upper2 bound too high")
u2 = ub2
END IF
IF (PRESENT(value)) THEN
area%d%c2_dp(l:u, l2:u2) = value%c_dp
ELSE
area%d%c2_dp(l:u, l2:u2) = CMPLX(0.0, 0.0, real_8)
END IF
CASE default
DBCSR_ABORT("Invalid or unsupported data type.")
END SELECT
IF (acc_devmem_allocated(area%d%acc_devmem)) THEN
IF (PRESENT(value)) &
DBCSR_ABORT("dbcsr_data_clear0 with value not implemented for acc_devmem")
s = dbcsr_datatype_sizeof(area%d%data_type)
CALL acc_devmem_setzero_bytes(area%d%acc_devmem, s*l, s*u, area%d%memory_type%acc_stream)
END IF
! CALL timestop(handle)
END SUBROUTINE dbcsr_data_clear0