dbcsr_data_ensure_size Subroutine

public 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.

Arguments

TypeIntentOptionalAttributesName
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

Contents


Source Code

   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