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 | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_data_obj), | intent(inout) | :: | area |
data area to repoint |
||
integer, | intent(in) | :: | rsize |
size of data area to point to size of data area to point to |
||
integer, | intent(in) | :: | 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 |
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