dbcsr_data_convert Subroutine

public subroutine dbcsr_data_convert(target_area, source_area, drop_real, multiply_by_i)

Copies a data area, converting data type

Arguments

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

Source Code

   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