Copies a data area, deep by default.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_data_obj), | intent(inout) | :: | target_area |
target data area |
||
type(dbcsr_data_obj), | intent(in) | :: | source_area |
source data area |
||
logical, | intent(in), | optional | :: | shallow |
shallow copy (default is deep) |
SUBROUTINE dbcsr_data_copyall(target_area, source_area, shallow)
!! Copies a data area, deep by default.
TYPE(dbcsr_data_obj), INTENT(INOUT) :: target_area
!! target data area
TYPE(dbcsr_data_obj), INTENT(IN) :: source_area
!! source data area
LOGICAL, INTENT(IN), OPTIONAL :: shallow
!! shallow copy (default is deep)
INTEGER :: i, n
LOGICAL :: shallow_copy
! ---------------------------------------------------------------------------
IF (.NOT. ASSOCIATED(source_area%d)) &
DBCSR_ABORT("Attempt to copy unassigned data")
IF (source_area%d%refcount .LE. 0) &
DBCSR_WARN("Attempt to copy unheld data")
shallow_copy = .FALSE.
IF (PRESENT(shallow)) shallow_copy = shallow
IF (shallow_copy) THEN
target_area = source_area
CALL dbcsr_data_hold(target_area)
ELSE
IF (.NOT. ASSOCIATED(target_area%d)) &
DBCSR_ABORT("Target area does not exist.")
CALL dbcsr_data_set_size_referenced(target_area, &
dbcsr_data_get_size_referenced(source_area))
n = dbcsr_data_get_size_referenced(source_area)
SELECT CASE (target_area%d%data_type)
CASE (dbcsr_type_real_4)
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(I) SHARED(target_area,source_area,n)
DO i = 1, n
target_area%d%r_sp(i) = source_area%d%r_sp(i)
END DO
CASE (dbcsr_type_real_8)
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(I) SHARED(target_area,source_area,n)
DO i = 1, n
target_area%d%r_dp(i) = source_area%d%r_dp(i)
END DO
CASE (dbcsr_type_complex_4)
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(I) SHARED(target_area,source_area,n)
DO i = 1, n
target_area%d%c_sp(i) = source_area%d%c_sp(i)
END DO
CASE (dbcsr_type_complex_8)
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(I) SHARED(target_area,source_area,n)
DO i = 1, n
target_area%d%c_dp(i) = source_area%d%c_dp(i)
END DO
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
END IF
! CALL timestop(error_handle)
END SUBROUTINE dbcsr_data_copyall