Ensures a minimum size of a previously-setup data area. The data area must have been previously setup with dbcsr_data_new.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_data_obj), | intent(inout) | :: | area |
data area |
||
| integer, | intent(in) | :: | data_size |
allocate this much data |
||
| logical, | intent(in), | optional | :: | nocopy |
do not keep potentially existing data, default is to keep it pad new data with zeros |
|
| logical, | intent(in), | optional | :: | zero_pad |
do not keep potentially existing data, default is to keep it pad new data with zeros |
|
| real(kind=dp), | intent(in), | optional | :: | factor |
increase size by this factor |
|
| type(dbcsr_data_obj), | intent(inout), | optional | :: | area_resize |
SUBROUTINE dbcsr_data_ensure_size(area, data_size, nocopy, zero_pad, factor, &
area_resize)
!! Ensures a minimum size of a previously-setup data area.
!! The data area must have been previously setup with dbcsr_data_new.
TYPE(dbcsr_data_obj), INTENT(INOUT) :: area
!! data area
INTEGER, INTENT(IN) :: data_size
!! allocate this much data
LOGICAL, INTENT(IN), OPTIONAL :: nocopy, zero_pad
!! do not keep potentially existing data, default is to keep it
!! pad new data with zeros
REAL(KIND=dp), INTENT(IN), OPTIONAL :: factor
!! increase size by this factor
TYPE(dbcsr_data_obj), INTENT(INOUT), OPTIONAL :: area_resize
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_ensure_size'
INTEGER :: current_size, handle, wanted_size
LOGICAL :: nocp, pad
TYPE(dbcsr_data_obj) :: area_tmp
! ---------------------------------------------------------------------------
IF (careful_mod) CALL timeset(routineN, handle)
IF (.NOT. ASSOCIATED(area%d)) &
DBCSR_ABORT("Data area must be setup.")
current_size = dbcsr_data_get_size(area)
IF (PRESENT(area_resize)) THEN
! Sanity check
IF (.NOT. dbcsr_data_valid(area_resize)) &
DBCSR_ABORT("Previous data area must be setup.")
IF (dbcsr_data_exists(area_resize)) &
DBCSR_ABORT("Previous data area must be not associated.")
IF (area%d%memory_type%acc_devalloc) &
DBCSR_ABORT("Cannot use dev memory with previous data area.")
IF (ASSOCIATED(area%d%memory_type%pool)) &
DBCSR_ABORT("Cannot use memory pool with previous data area.")
END IF
wanted_size = data_size
#if defined(__HAS_smm_dnn) && defined(__HAS_smm_vec)
! allocate some more as padding for libsmm kernels which read over the end.
IF (data_size .GT. 0) THEN
wanted_size = data_size + 10
END IF
#endif
!IF(area%d%memory_type%acc_devalloc) THEN
! IF(current_size==acc_devmem_size(area%d%acc_devmem)) &
! WRITE (*,*) "dbcsr_data_ensure_size: Host and device buffer differ in size."
!END IF
!IF(current_size/=acc_devmem_size(area%d%acc_devmem)) &
! DBCSR_ABORT("Host and device buffer differ in size.")
CALL dbcsr_data_set_size_referenced(area, data_size)
IF (current_size .GT. 1 .AND. current_size .GE. wanted_size) THEN
IF (careful_mod) CALL timestop(handle)
RETURN
END IF
!
nocp = .FALSE.
IF (PRESENT(nocopy)) nocp = nocopy
pad = .FALSE.
IF (PRESENT(zero_pad)) pad = zero_pad
IF (dbcsr_data_exists(area)) THEN
IF (nocp .AND. dbcsr_data_get_size(area) <= 1) THEN
IF (PRESENT(area_resize)) THEN
CALL dbcsr_data_set_pointer(area_resize, &
dbcsr_data_get_size(area), 1, area)
CALL dbcsr_data_clear_pointer(area)
ELSE
CALL internal_data_deallocate(area%d)
END IF
END IF
END IF
IF (.NOT. dbcsr_data_exists(area)) THEN
IF (ASSOCIATED(area%d%memory_type%pool)) THEN
area_tmp = dbcsr_mempool_get(area%d%memory_type, area%d%data_type, wanted_size)
IF (ASSOCIATED(area_tmp%d)) THEN
area_tmp%d%ref_size = wanted_size
area_tmp%d%refcount = area%d%refcount
DEALLOCATE (area%d)
area = area_tmp
END IF
END IF
IF (.NOT. dbcsr_data_exists(area)) &
CALL internal_data_allocate(area%d, (/wanted_size/))
IF (pad) CALL dbcsr_data_zero(area, (/1/), (/wanted_size/))
ELSE
SELECT CASE (area%d%data_type)
CASE (dbcsr_type_int_8)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%i8, &
array_resize=area_resize%d%i8, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%i8, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE (dbcsr_type_int_4)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%i4, &
array_resize=area_resize%d%i4, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%i4, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE (dbcsr_type_real_8)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%r_dp, &
array_resize=area_resize%d%r_dp, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%r_dp, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE (dbcsr_type_real_4)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%r_sp, &
array_resize=area_resize%d%r_sp, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%r_sp, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE (dbcsr_type_complex_8)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%c_dp, &
array_resize=area_resize%d%c_dp, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%c_dp, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE (dbcsr_type_complex_4)
IF (PRESENT(area_resize)) THEN
CALL ensure_array_size(area%d%c_sp, &
array_resize=area_resize%d%c_sp, &
ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
ELSE
CALL ensure_array_size(area%d%c_sp, ub=wanted_size, &
memory_type=area%d%memory_type, &
nocopy=nocp, zero_pad=zero_pad, &
factor=factor)
END IF
CASE default
DBCSR_ABORT("Invalid data type are supported")
END SELECT
IF (area%d%memory_type%acc_devalloc) THEN
IF (.NOT. acc_devmem_allocated(area%d%acc_devmem)) THEN
CALL acc_devmem_allocate_bytes(area%d%acc_devmem, &
dbcsr_datatype_sizeof(area%d%data_type)*dbcsr_data_get_size(area))
IF (pad) CALL acc_devmem_setzero_bytes(area%d%acc_devmem, stream=area%d%memory_type%acc_stream)
ELSE
CALL acc_devmem_ensure_size_bytes(area%d%acc_devmem, &
area%d%memory_type%acc_stream, &
dbcsr_datatype_sizeof(area%d%data_type)*dbcsr_data_get_size(area), &
nocopy, zero_pad)
END IF
CALL acc_event_record(area%d%acc_ready, area%d%memory_type%acc_stream)
IF (dbcsr_datatype_sizeof(area%d%data_type)*dbcsr_data_get_size(area) &
/= acc_devmem_size_in_bytes(area%d%acc_devmem)) &
DBCSR_ABORT("Host and device buffer differ in size.")
END IF
END IF
IF (careful_mod) CALL timestop(handle)
END SUBROUTINE dbcsr_data_ensure_size