setup_buffers Subroutine

private subroutine setup_buffers(buffer_1, buffer_2, buffers, nbuffers, data_size, meta_size, matrix, imgdist)

Arguments

Type IntentOptional Attributes Name
type(dbcsr_buffer), intent(inout), TARGET :: buffer_1
type(dbcsr_buffer), intent(inout), TARGET :: buffer_2
type(dbcsr_buffer), intent(inout), ALLOCATABLE, DIMENSION(:) :: buffers
integer, intent(in) :: nbuffers
integer, intent(in) :: data_size
integer, intent(in) :: meta_size
type(dbcsr_type), intent(in) :: matrix
type(dbcsr_imagedistribution_obj), intent(inout) :: imgdist

Source Code

   SUBROUTINE setup_buffers(buffer_1, buffer_2, buffers, nbuffers, data_size, meta_size, matrix, imgdist)
      TYPE(dbcsr_buffer), INTENT(INOUT), TARGET          :: buffer_1, buffer_2
      TYPE(dbcsr_buffer), ALLOCATABLE, DIMENSION(:), &
         INTENT(INOUT)                                   :: buffers
      INTEGER, INTENT(IN)                                :: nbuffers, data_size, meta_size
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      TYPE(dbcsr_imagedistribution_obj), INTENT(INOUT)   :: imgdist

      INTEGER                                            :: ibuffer, jbuffer
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: meta_p
      LOGICAL                                            :: has_trs_stackbuf
      TYPE(dbcsr_buffer), POINTER                        :: buffer_p

      ALLOCATE (buffers(nbuffers))
      has_trs_stackbuf = dbcsr_data_valid(buffer_1%trs_stackbuf) .OR. dbcsr_data_valid(buffer_2%trs_stackbuf)
      DO ibuffer = 1, nbuffers
         jbuffer = (ibuffer - 1)/2
         IF (MOD(ibuffer, 2) .EQ. 1) THEN
            buffer_p => buffer_1
         ELSE
            buffer_p => buffer_2
         END IF
         ! Use slices for the 3D buffers
         CALL dbcsr_data_init(buffers(ibuffer)%data)
         CALL dbcsr_data_new(buffers(ibuffer)%data, dbcsr_data_get_type(buffer_p%data), &
                             memory_type=dbcsr_data_get_memory_type(buffer_p%data))
         IF (buffers(ibuffer)%data%d%memory_type%acc_devalloc) THEN
            CALL acc_event_create(buffers(ibuffer)%data%d%acc_ready)
         END IF
         CALL dbcsr_data_set_pointer( &
            area=buffers(ibuffer)%data, &
            rsize=data_size, &
            csize=1, &
            pointee=buffer_p%data, &
            source_lb=data_size*jbuffer + 1)
         ! Use meta_p pointer to avoid warning target-lifetime
         meta_p => buffer_p%meta(meta_size*jbuffer + 1: &
                                 meta_size*(jbuffer + 1))
         buffers(ibuffer)%meta => meta_p
         IF (has_trs_stackbuf) THEN
            CALL dbcsr_data_init(buffers(ibuffer)%trs_stackbuf)
            CALL dbcsr_data_new(buffers(ibuffer)%trs_stackbuf, dbcsr_data_get_type(buffer_p%trs_stackbuf), &
                                memory_type=dbcsr_data_get_memory_type(buffer_p%trs_stackbuf))
            IF (buffers(ibuffer)%trs_stackbuf%d%memory_type%acc_devalloc) THEN
               CALL acc_event_create(buffers(ibuffer)%trs_stackbuf%d%acc_ready)
            END IF
            CALL dbcsr_data_set_pointer( &
               area=buffers(ibuffer)%trs_stackbuf, &
               rsize=meta_size/3, &
               csize=1, &
               pointee=buffer_p%trs_stackbuf, &
               source_lb=(meta_size/3)*jbuffer + 1)
         END IF
         CALL setup_buffer_matrix_image(buffers(ibuffer)%matrix, imgdist, matrix, &
                                        buffers(ibuffer)%data, &
                                        buffers(ibuffer)%meta)
      END DO
   END SUBROUTINE setup_buffers