buffer_init Subroutine

private subroutine buffer_init(buffer, data_type, data_size, meta_size, num_data, data_memory_type, trs_memory_type)

Init buffer

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_buffer), intent(inout) :: buffer
integer, intent(in) :: data_type
integer, intent(in) :: data_size
integer, intent(in) :: meta_size
integer, intent(in), optional :: num_data
type(dbcsr_memtype_type), intent(in) :: data_memory_type
type(dbcsr_memtype_type), intent(in), optional :: trs_memory_type

Contents

Source Code


Source Code

   SUBROUTINE buffer_init(buffer, data_type, &
      !! Init buffer
                          data_size, meta_size, &
                          num_data, &
                          data_memory_type, trs_memory_type)
      TYPE(dbcsr_buffer), INTENT(INOUT)                  :: buffer
      INTEGER, INTENT(IN)                                :: data_type, data_size, meta_size
      INTEGER, INTENT(IN), OPTIONAL                      :: num_data
      TYPE(dbcsr_memtype_type), INTENT(IN)               :: data_memory_type
      TYPE(dbcsr_memtype_type), INTENT(IN), OPTIONAL     :: trs_memory_type

      INTEGER                                            :: my_num_data
      LOGICAL                                            :: new_trs_stackbuf

      my_num_data = 1
      IF (PRESENT(num_data)) THEN
         my_num_data = num_data
      ELSE
         IF (dbcsr_data_valid(buffer%data_before_resize) .OR. ASSOCIATED(buffer%meta_before_resize)) &
            DBCSR_ABORT("Previous data area already initialized.")
         CALL dbcsr_data_init(buffer%data_before_resize)
         CALL dbcsr_data_new(buffer%data_before_resize, data_type, memory_type=data_memory_type)
      END IF
      new_trs_stackbuf = PRESENT(trs_memory_type) .AND. has_acc
      !
      IF (buffer%is_valid) THEN
         ! Invalid buffers if data_type is different
         IF (dbcsr_data_get_type(buffer%data) .NE. data_type) THEN
            CALL dbcsr_data_release(buffer%data)
            IF (new_trs_stackbuf) THEN
               CALL dbcsr_data_release(buffer%trs_stackbuf)
            END IF
            buffer%is_valid = .FALSE.
         END IF
      END IF
      !
      IF (.NOT. buffer%is_valid) THEN
         ! First initialization
         CALL dbcsr_data_init(buffer%data)
         CALL dbcsr_data_new(buffer%data, data_type=data_type, &
                             data_size=data_size*my_num_data, memory_type=data_memory_type)
         CALL dbcsr_data_set_size_referenced(buffer%data, data_size*my_num_data)
         IF (new_trs_stackbuf) THEN
            CALL dbcsr_data_init(buffer%trs_stackbuf)
            CALL dbcsr_data_new(buffer%trs_stackbuf, &
                                data_type=dbcsr_type_int_4, data_size=(meta_size/3)*my_num_data, &
                                memory_type=trs_memory_type)
         END IF
         buffer%is_valid = .TRUE.
      ELSE
         IF (PRESENT(num_data)) THEN
            CALL dbcsr_data_ensure_size(buffer%data, data_size*my_num_data, nocopy=.TRUE.)
            IF (new_trs_stackbuf) THEN
               CALL dbcsr_data_ensure_size(buffer%trs_stackbuf, (meta_size/3)*my_num_data, nocopy=.TRUE.)
            END IF
         ELSE
            ! Case for MPI windows
            ! data_before_resize keeps the pointer to previous data in the case of reallocation
            CALL dbcsr_data_ensure_size(buffer%data, data_size, nocopy=.TRUE., &
                                        area_resize=buffer%data_before_resize)
         END IF
      END IF
      !
      IF (PRESENT(num_data)) THEN
         CALL ensure_array_size(buffer%meta, ub=meta_size*my_num_data, nocopy=.TRUE., &
                                memory_type=memtype_mpi_buffer)
      ELSE
         ! Case for MPI windows
         ! meta_before_resize keeps the pointer to previous meta in the case of reallocation
         CALL ensure_array_size(buffer%meta, array_resize=buffer%meta_before_resize, &
                                ub=meta_size, nocopy=.TRUE., &
                                memory_type=memtype_mpi_buffer)
      END IF
      !
      buffer%is_comm = .FALSE.
   END SUBROUTINE buffer_init