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