irpjast/qmckl_dgemm.org

QMCkl dgemm

• Fortran interface
• C code

Generated from qmckl_dgemm.org

Fortran interface

! <<header>>

module qmckl_blas
  use :: iso_c_binding

  interface
     subroutine qmckl_dgemm(transa, transb, m, n, k, &
          alpha, A, lda, B, ldb, beta, C, ldc) bind(C)
       use :: iso_c_binding
       implicit none
       character(kind=c_char  ), value :: transa, transb
       integer  (kind=c_int   ), value :: m, n, k, lda, ldb, ldc
       real     (kind=c_double), value :: alpha, beta
       real     (kind=c_double)        :: A(lda,*), B(ldb,*), C(ldc,*)
     end subroutine qmckl_dgemm
  end interface

end module qmckl_blas

C code

To avoid passing too many arguments to recursive subroutines, we put all the arguments in a struct.

struct dgemm_args {
double alpha; 
double beta;
double* A;
double* B;
double* C;
int m;
int n;
int k;
int lda;
int ldb;
int ldc;
CBLAS_LAYOUT transa;
CBLAS_LAYOUT transb;
};

The driver routine packs the arguments in the struct and calls the recursive routine.

void qmckl_dgemm(char transa, char transb,
               int m, int n, int k,
               double alpha, 
               double* A, int lda,
               double* B, int ldb,
               double beta,
               double* C, int ldc)
{
struct dgemm_args args; 

args.alpha = alpha;
args.beta  = beta ;
args.A = A;
args.B = B;
args.C = C;
args.m = m;
args.n = n;
args.k = k;
args.lda = lda;
args.ldb = ldb;
args.ldc = ldc;

if (transa == 'T' || transa == 't') {
  args.transa = CblasTrans; 
} else {
  args.transa = CblasNoTrans; 
}

CBLAS_LAYOUT tb;
if (transa == 'T' || transa == 't') {
  args.transb = CblasTrans; 
} else {
  args.transb = CblasNoTrans; 
}

qmckl_dgemm_rec(args);
}

static void qmckl_dgemm_rec(struct dgemm_args args) {

cblas_dgemm(CblasColMajor, args.transa, args.transb, 
            args.m, args.n, args.k, args.alpha,
            args.A, args.lda, args.B, args.ldb,
            args.beta, args.C, args.ldc);

}

/* <<header>> */

#include <cblas.h>

<<dgemm_args>>

<<dgemm_rec>>

<<dgemm>>