mirror of
https://github.com/TREX-CoE/irpjast.git
synced 2024-10-02 14:31:07 +02:00
125 lines
2.4 KiB
Org Mode
125 lines
2.4 KiB
Org Mode
#+TITLE: QMCkl dgemm
|
|
|
|
#+NAME: header
|
|
#+BEGIN_SRC text
|
|
Generated from qmckl_dgemm.org
|
|
#+END_SRC
|
|
|
|
* Fortran interface
|
|
|
|
#+BEGIN_SRC f90 :noweb yes :tangle qmckl_blas_f.f90
|
|
! <<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
|
|
#+END_SRC
|
|
|
|
* C code
|
|
To avoid passing too many arguments to recursive subroutines, we put
|
|
all the arguments in a struct.
|
|
|
|
#+NAME: dgemm_args
|
|
#+BEGIN_SRC c
|
|
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;
|
|
};
|
|
|
|
#+END_SRC
|
|
|
|
The driver routine packs the arguments in the struct and calls the
|
|
recursive routine.
|
|
|
|
#+NAME: dgemm
|
|
#+BEGIN_SRC c
|
|
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);
|
|
}
|
|
|
|
#+END_SRC
|
|
|
|
|
|
#+NAME: dgemm_rec
|
|
#+BEGIN_SRC c
|
|
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);
|
|
|
|
}
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC c :noweb yes :tangle qmckl_dgemm.c
|
|
/* <<header>> */
|
|
|
|
#include <cblas.h>
|
|
|
|
<<dgemm_args>>
|
|
|
|
<<dgemm_rec>>
|
|
|
|
<<dgemm>>
|
|
#+END_SRC
|
|
|