Copies a data area, converting data type
| 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 | :: | drop_real |
drops real part of complex numbers instead of the imaginary part; default is false converts real to complex by placing into imaginary instead of real part |
|
| logical, | intent(in), | optional | :: | multiply_by_i |
drops real part of complex numbers instead of the imaginary part; default is false converts real to complex by placing into imaginary instead of real part |
SUBROUTINE dbcsr_data_convert(target_area, source_area, drop_real, &
multiply_by_i)
!! Copies a data area, converting data type
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 :: drop_real, multiply_by_i
!! drops real part of complex numbers instead of the imaginary part; default is false
!! converts real to complex by placing into imaginary instead of real part
COMPLEX(KIND=real_4), DIMENSION(:), POINTER, CONTIGUOUS :: s_data_c, t_data_c
COMPLEX(KIND=real_8), DIMENSION(:), POINTER, CONTIGUOUS :: s_data_z, t_data_z
INTEGER :: n, ns, nt
LOGICAL :: keep_real, noimult
REAL(KIND=real_4), DIMENSION(:), POINTER, CONTIGUOUS :: s_data_r, t_data_r
REAL(KIND=real_8), DIMENSION(:), POINTER, CONTIGUOUS :: s_data_d, t_data_d
! ---------------------------------------------------------------------------
IF (.NOT. ASSOCIATED(source_area%d)) &
DBCSR_WARN("Attempt to copy unassigned data")
IF (source_area%d%refcount .LE. 0) &
DBCSR_WARN("Attempt to copy unheld data")
IF (.NOT. ASSOCIATED(source_area%d)) THEN
RETURN
END IF
keep_real = .TRUE.
IF (PRESENT(drop_real)) keep_real = .NOT. drop_real
noimult = .TRUE.
IF (PRESENT(multiply_by_i)) noimult = .NOT. multiply_by_i
ns = dbcsr_data_get_size_referenced(source_area)
nt = dbcsr_data_get_size_referenced(target_area)
n = MIN(ns, nt)
IF (n .GT. 0) THEN
SELECT CASE (source_area%d%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(source_area, s_data_d)
SELECT CASE (target_area%d%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(target_area, t_data_d)
t_data_d(1:n) = s_data_d(1:n)
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(target_area, t_data_r)
t_data_r(1:n) = REAL(s_data_d(1:n), KIND=real_4)
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(target_area, t_data_z)
IF (noimult) THEN
t_data_z(1:n) = CMPLX(s_data_d(1:n), KIND=real_8)
ELSE
t_data_z(1:n) = CMPLX(0.0, s_data_d(1:n), KIND=real_8)
END IF
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(target_area, t_data_c)
IF (noimult) THEN
t_data_c(1:n) = CMPLX(s_data_d(1:n), KIND=real_4)
ELSE
t_data_c(1:n) = CMPLX(0.0, s_data_d(1:n), KIND=real_4)
END IF
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(source_area, s_data_r)
SELECT CASE (target_area%d%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(target_area, t_data_d)
t_data_d(1:n) = REAL(s_data_r(1:n), KIND=real_8)
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(target_area, t_data_r)
t_data_r(1:n) = s_data_r(1:n)
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(target_area, t_data_z)
IF (noimult) THEN
t_data_z(1:n) = CMPLX(s_data_r(1:n), KIND=real_8)
ELSE
t_data_z(1:n) = CMPLX(0.0, s_data_r(1:n), KIND=real_8)
END IF
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(target_area, t_data_c)
IF (noimult) THEN
t_data_c(1:n) = CMPLX(s_data_r(1:n), KIND=real_4)
ELSE
t_data_c(1:n) = CMPLX(0.0, s_data_r(1:n), KIND=real_4)
END IF
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(source_area, s_data_z)
SELECT CASE (target_area%d%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(target_area, t_data_d)
IF (keep_real) THEN
t_data_d(1:n) = REAL(s_data_z(1:n), KIND=real_8)
ELSE
t_data_d(1:n) = AIMAG(s_data_z(1:n))
END IF
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(target_area, t_data_r)
IF (keep_real) THEN
t_data_r(1:n) = REAL(s_data_z(1:n), KIND=real_4)
ELSE
t_data_r(1:n) = REAL(AIMAG(s_data_z(1:n)), KIND=real_4)
END IF
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(target_area, t_data_z)
t_data_z(1:n) = s_data_z(1:n)
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(target_area, t_data_c)
t_data_c(1:n) = CMPLX(s_data_z(1:n), KIND=real_4)
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(source_area, s_data_c)
SELECT CASE (target_area%d%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(target_area, t_data_d)
IF (keep_real) THEN
t_data_d(1:n) = REAL(s_data_c(1:n), KIND=real_8)
ELSE
t_data_d(1:n) = REAL(AIMAG(s_data_c(1:n)), KIND=real_8)
END IF
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(target_area, t_data_r)
IF (keep_real) THEN
t_data_r(1:n) = REAL(s_data_c(1:n), KIND=real_4)
ELSE
t_data_r(1:n) = AIMAG(s_data_c(1:n))
END IF
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(target_area, t_data_z)
t_data_z(1:n) = CMPLX(s_data_c(1:n), KIND=real_8)
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(target_area, t_data_c)
t_data_c(1:n) = s_data_c(1:n)
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
END IF
END SUBROUTINE dbcsr_data_convert