dbcsr_mm_sched_process Subroutine

public subroutine dbcsr_mm_sched_process(this, left, right, stack_data, stack_fillcount, stack_descr)

Processes a given stack. From here on there is no boundary checking due to assumed-SIZE-arguments. This is useful to check stack parameters, BUT it works only for kind=dp

Arguments

Type IntentOptional Attributes Name
type(dbcsr_mm_sched_type), intent(inout) :: this
type(dbcsr_type), intent(in) :: left
type(dbcsr_type), intent(in) :: right
integer, DIMENSION(:, :), POINTER :: stack_data
integer, POINTER :: stack_fillcount
type(stack_descriptor_type), intent(in) :: stack_descr

Source Code

   SUBROUTINE dbcsr_mm_sched_process(this, left, right, stack_data, &
                                     stack_fillcount, stack_descr)
      !! Processes a given stack.
      TYPE(dbcsr_mm_sched_type), INTENT(INOUT)           :: this
      TYPE(dbcsr_type), INTENT(IN)                       :: left, right
      INTEGER, DIMENSION(:, :), POINTER                  :: stack_data
      INTEGER, POINTER                                   :: stack_fillcount
      TYPE(stack_descriptor_type), INTENT(IN)            :: stack_descr

      INTEGER                                            :: ithread, sp, stacked_datasize
      INTEGER(kind=int_8)                                :: flop_per_entry, total_flop
      LOGICAL                                            :: success, used_smm
      TYPE(stats_type), POINTER                          :: mystats

      IF (stack_fillcount <= 0) &
         DBCSR_ABORT("dbcsr_mm_sched_process: got empty stack")

      ithread = 0
!$    ithread = OMP_GET_THREAD_NUM()
      mystats => stats_per_thread(ithread)

      CALL ensure_product_wm_cleared(this)

      stacked_datasize = this%product_wm%datasize
      CALL dbcsr_data_ensure_size(this%product_wm%data_area, stacked_datasize, &
                                  factor=default_resize_factor, zero_pad=.TRUE.)

      !!From here on there is no boundary checking due to assumed-SIZE-arguments.
      !!This is useful to check stack parameters, BUT it works only for kind=dp
      IF (.FALSE.) THEN
         DO sp = 1, stack_fillcount
            IF (stack_data(p_a_first, sp) > SIZE(left%data_area%d%r_dp)) &
               DBCSR_ABORT("left data out of range")
            IF (stack_data(p_b_first, sp) > SIZE(right%data_area%d%r_dp)) &
               DBCSR_ABORT("right data out of range")
            IF (stack_data(p_c_first, sp) > SIZE(this%product_wm%data_area%d%r_dp)) THEN
               WRITE (*, *) "blub: ", stack_data(p_c_first, sp), SIZE(this%product_wm%data_area%d%r_dp), &
                  dbcsr_data_get_size(this%product_wm%data_area), stacked_datasize
               DBCSR_ABORT("product data out of range")
            END IF
         END DO
      END IF

      IF (.FALSE.) THEN
         ! Check if homogeneous stacks are indeed homogeneous
         IF (stack_descr%defined_mnk) THEN
            DO sp = 1, stack_fillcount
               IF (stack_data(p_m, sp) /= stack_descr%m) &
                  DBCSR_ABORT("homogeneous stacks check failed")
               IF (stack_data(p_n, sp) /= stack_descr%n) &
                  DBCSR_ABORT("homogeneous stacks check failed")
               IF (stack_data(p_k, sp) /= stack_descr%k) &
                  DBCSR_ABORT("homogeneous stacks check failed")
            END DO
         END IF
      END IF

      ! Submitting the stack for processing -------------------------------------
      flop_per_entry = INT(2, KIND=int_8)*stack_descr%max_m*stack_descr%max_n*stack_descr%max_k
      total_flop = stack_fillcount*flop_per_entry

      IF (has_acc .AND. &
          flop_per_entry > dbcsr_cfg%accdrv_min_flop_process%val .AND. &
          (.NOT. this%avoid_accdrv) .AND. &
          (stack_descr%defined_mnk .OR. dbcsr_cfg%accdrv_do_inhomogenous%val)) THEN
         CALL dbcsr_mm_accdrv_process( &
            this%accdrv, &
            left, right, &
            params=stack_data, &
            stack_size=stack_fillcount, &
            stack_descr=stack_descr, &
            success=success)

         IF (success) THEN
            ! update statistics
            mystats%acc_num_stacks = mystats%acc_num_stacks + 1
            mystats%acc_flop = mystats%acc_flop + total_flop
            CALL stats_add(mystats, &
                           m=stack_descr%m, n=stack_descr%n, k=stack_descr%k, &
                           stacksize_acc=INT(stack_fillcount, kind=int_8))
            RETURN
         ELSE
            this%avoid_accdrv = dbcsr_cfg%accdrv_avoid_after_busy%val
         END IF
      END IF

      !WRITE (*,*) "dbcsr_mm_sched_process: running hostdrv_process, stack_fillcount:", stack_fillcount

      CALL dbcsr_mm_hostdrv_process( &
         this%hostdrv, &
         left, right, &
         params=stack_data, &
         stack_size=stack_fillcount, &
         stack_descr=stack_descr, &
         success=success, &
         used_smm=used_smm)

      IF (.NOT. success) DBCSR_ABORT("dbcsr_mm_sched_process_stack failed")

      ! update statistics
      IF (used_smm) THEN
         mystats%smm_num_stacks = mystats%smm_num_stacks + 1
         mystats%smm_flop = mystats%smm_flop + total_flop
         CALL stats_add(mystats, &
                        m=stack_descr%m, n=stack_descr%n, k=stack_descr%k, &
                        stacksize_smm=INT(stack_fillcount, kind=int_8))
      ELSE
         mystats%cpu_num_stacks = mystats%cpu_num_stacks + 1
         mystats%cpu_flop = mystats%cpu_flop + total_flop
         CALL stats_add(mystats, &
                        m=stack_descr%m, n=stack_descr%n, k=stack_descr%k, &
                        stacksize_cpu=INT(stack_fillcount, kind=int_8))
      END IF

   END SUBROUTINE dbcsr_mm_sched_process