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