set_data_area_area Subroutine

   SUBROUTINE set_data_area_area(area, rsize, csize, pointee, source_lb)
      !! Points data area data pointers to another data area
      !! Assumes that no memory will be lost when repointing the pointer in the data
      !! area and that the area is initialized.

      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: area
         !! data area to repoint
      INTEGER, INTENT(IN)                                :: rsize, csize
         !! size of data area to point to
         !! size of data area to point to
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: pointee
         !! data area to point to
      INTEGER, INTENT(IN), OPTIONAL                      :: source_lb
         !! point to this offset in pointee

      COMPLEX(KIND=real_4), DIMENSION(:), POINTER        :: c_sp
      COMPLEX(KIND=real_8), DIMENSION(:), POINTER        :: c_dp
      INTEGER                                            :: bp, dt1, dt2, nze
      LOGICAL                                            :: compatible, pointee_is_2d, rmp
      REAL(KIND=real_4), DIMENSION(:), POINTER           :: r_sp
      REAL(KIND=real_8), DIMENSION(:), POINTER           :: r_dp

!   ---------------------------------------------------------------------------

      bp = 1; IF (PRESENT(source_lb)) bp = source_lb
      nze = rsize*csize
      dt1 = area%d%data_type
      dt2 = pointee%d%data_type
      IF (careful_mod) THEN
         compatible = dt1 .EQ. dt2 .OR. dt1 .EQ. dbcsr_type_1d_to_2d(dt2)
         IF (.NOT. compatible) &
            DBCSR_ABORT("Can not point 1-d pointer to 2-d data")

      END IF
      pointee_is_2d = dbcsr_type_is_2d(dt2)
      IF (careful_mod) THEN
         IF (PRESENT(source_lb) .AND. pointee_is_2d) &
            DBCSR_ABORT("Lower bound specification not possible with 2-d data")
         ! Check if size is OK.
         IF (bp < 1) &
            DBCSR_ABORT("Attempt to point out of bounds")
         IF (bp + nze - 1 > dbcsr_data_get_size(pointee)) &
            DBCSR_ABORT("Attempt to point out of bounds")
      END IF
      ! There's a remap if the ranks are compatible but not equal.
      rmp = dt1 .NE. dt2
      SELECT CASE (dt2)
      CASE (dbcsr_type_int_4)
         area%d%i4 => pointee%d%i4(bp:bp + nze - 1)
      CASE (dbcsr_type_real_4_2d)
         area%d%r2_sp => pointee%d%r2_sp(1:rsize, 1:csize)
      CASE (dbcsr_type_real_4)
         IF (rmp) THEN
            r_sp => dbcsr_get_data_p_s(pointee, bp, bp + nze - 1)
            CALL pointer_rank_remap2(area%d%r2_sp, rsize, csize, &
                                     r_sp)
         ELSE
            area%d%r_sp => dbcsr_get_data_p_s(pointee, bp, bp + nze - 1)
         END IF
      CASE (dbcsr_type_real_8_2d)
         area%d%r2_dp => pointee%d%r2_dp(1:rsize, 1:csize)
      CASE (dbcsr_type_real_8)
         IF (rmp) THEN
            r_dp => dbcsr_get_data_p_d(pointee, bp, bp + nze - 1)
            CALL pointer_rank_remap2(area%d%r2_dp, rsize, csize, &
                                     r_dp)
         ELSE
            area%d%r_dp => dbcsr_get_data_p_d(pointee, bp, bp + nze - 1)
         END IF
      CASE (dbcsr_type_complex_4_2d)
         area%d%c2_sp => pointee%d%c2_sp(1:rsize, 1:csize)
      CASE (dbcsr_type_complex_4)
         IF (rmp) THEN
            c_sp => dbcsr_get_data_p_c(pointee, bp, bp + nze - 1)
            CALL pointer_rank_remap2(area%d%c2_sp, rsize, csize, &
                                     c_sp)
         ELSE
            area%d%c_sp => dbcsr_get_data_p_c(pointee, bp, bp + nze - 1)
         END IF
      CASE (dbcsr_type_complex_8_2d)
         area%d%c2_dp => pointee%d%c2_dp(1:rsize, 1:csize)
      CASE (dbcsr_type_complex_8)
         IF (rmp) THEN
            c_dp => dbcsr_get_data_p_z(pointee, bp, bp + nze - 1)
            CALL pointer_rank_remap2(area%d%c2_dp, rsize, csize, &
                                     c_dp)
         ELSE
            area%d%c_dp => dbcsr_get_data_p_z(pointee, bp, bp + nze - 1)
         END IF
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
      CALL dbcsr_data_set_size_referenced(area, rsize*csize)
      IF (debug_mod) THEN
         IF (dbcsr_data_get_size_referenced(area) /= dbcsr_data_get_size(area)) &
            DBCSR_ABORT("Size mismatch")
      END IF
      !
      IF (area%d%memory_type%acc_devalloc .AND. pointee%d%memory_type%acc_devalloc) THEN
         IF (pointee_is_2d) &
            DBCSR_ABORT("Setting GPU pointers for 2D data is not available!")
         CALL acc_devmem_set_cptr(area%d%acc_devmem, &
                                  pointee%d%acc_devmem, &
                                  dbcsr_datatype_sizeof(area%d%data_type)*nze, &
                                  dbcsr_datatype_sizeof(area%d%data_type)*(bp - 1))
      END IF
   END SUBROUTINE set_data_area_area