blas_process_mm_stack_d Subroutine

private subroutine blas_process_mm_stack_d(params, stack_size, a_data, b_data, c_data)

Processes MM stack and issues BLAS xGEMM calls

Arguments

Type IntentOptional Attributes Name
integer, intent(in), DIMENSION(dbcsr_ps_width, 1:stack_size) :: params

Stack of MM parameters
integer, intent(in) :: stack_size

Number of parameters
real(kind=real_8), intent(in), DIMENSION(*) :: a_data

Left-matrix data Right-matrix data
real(kind=real_8), intent(in), DIMENSION(*) :: b_data

Left-matrix data Right-matrix data
real(kind=real_8), intent(inout), DIMENSION(*) :: c_data

Product data

Source Code

      SUBROUTINE blas_process_mm_stack_d (params, &
                                                      stack_size, &
                                                      a_data, b_data, c_data)
     !! Processes MM stack and issues BLAS xGEMM calls

         INTEGER, INTENT(IN)                       :: stack_size
        !! Number of parameters
         INTEGER, DIMENSION(dbcsr_ps_width, 1:stack_size), &
            INTENT(IN)                              :: params
        !! Stack of MM parameters
         REAL(kind=real_8), DIMENSION(*), INTENT(IN)         :: a_data, &
            b_data
        !! Left-matrix data
        !! Right-matrix data
         REAL(kind=real_8), DIMENSION(*), INTENT(INOUT)      :: c_data
        !! Product data

         INTEGER                                   :: sp

!   ---------------------------------------------------------------------------

         DO sp = 1, stack_size
            CALL DGEMM ('N', &
                                   'N', &
                                   params(p_m, sp), params(p_n, sp), & !m, n
                                   params(p_k, sp), & ! k
                                   1.0_real_8, & ! alpha
                                   a_data(params(p_a_first, sp)), & ! A
                                   params(p_m, sp), & !lda
                                   b_data(params(p_b_first, sp)), & ! B
                                   params(p_k, sp), & !ldb
                                   1.0_real_8, & ! beta
                                   c_data(params(p_c_first, sp)), params(p_m, sp))
         END DO
      END SUBROUTINE blas_process_mm_stack_d