dbcsr_data_clear0 Subroutine

private subroutine dbcsr_data_clear0(area, lb, ub, value, lb2, ub2)

Clears a data area

Arguments

Type IntentOptional 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

Source Code

   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