void
F77_NAME(dgemm)(const char *transa, const char *transb, const int *m,
const int *n, const int *k, const double *alpha,
const double *a, const int *lda,
const double *b, const int *ldb,
const double *beta, double *c, const int *ldc)
{
DGEMM(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc);
}
void reference_dgemm (int N, double ALPHA, double* A, double* B, double* C)
{
char TRANSA = 'N';
char TRANSB = 'N';
int M = N;
int K = N;
double BETA = 1.;
int LDA = N;
int LDB = N;
int LDC = N;
DGEMM(&TRANSA, &TRANSB, &M, &N, &K, &ALPHA, A, &LDA, B, &LDB, &BETA, C, &LDC);
}
void GEMM<double>(const char* transA, const char* transB,
const int m , const int n , const int k ,
const double& a1 , const double* A , const int ldA,
const double* B , const int ldB,
const double& a2 , double* C , const int ldC)
{
ASSERT((transA[0] == 'N') || (transA[0] == 'T'));
ASSERT((transB[0] == 'N') || (transB[0] == 'T'));
DGEMM(F77_CHARACTER(transA[0]), F77_CHARACTER(transB[0]),
&m, &n, &k, &a1, A, &ldA, B, &ldB, &a2, C, &ldC);
}
static void multiply( double * M,
const double * A,
const double * B,
const size_t m,
const size_t n,
const size_t k )
{
double done;
double dzero;
done = 1;
dzero = 0;
DGEMM( "T", "N", &m, &n, &k, &done, A, &k, B, &k, &dzero, M, &m );
}
void ProtoMol::Lapack::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 *l) {
FAHCheckIn();
#if defined(HAVE_LAPACK)
dgemm_(transA, transB, m, n, k, alpha, A, lda, B, ldb, beta, C, l);
#elif defined(HAVE_SIMTK_LAPACK)
dgemm_(*transA, *transB, *m, *n, *k, *alpha, A, *lda, B, *ldb, *beta, C, *l);
#elif defined(HAVE_MKL_LAPACK)
DGEMM(transA, transB, m, n, k, alpha, A, lda, B, ldb, beta, C, l);
#else
THROW(std::string(__func__) + " not supported");
#endif
}
// Out = f * A * B
void Mxm(double *pOut, ptrdiff_t iRowStO, ptrdiff_t iColStO,
double const *pA, ptrdiff_t iRowStA, ptrdiff_t iColStA,
double const *pB, ptrdiff_t iRowStB, ptrdiff_t iColStB,
size_t nRows, size_t nLink, size_t nCols, bool AddToDest, double fFactor )
{
assert( iRowStO == 1 || iColStO == 1 );
assert( iRowStA == 1 || iColStA == 1 );
assert( iRowStB == 1 || iColStB == 1 );
// ^- otherwise dgemm directly not applicable. Would need local copy
// of matrix/matrices with compressed strides.
// if ( nRows == 1 || nLink == 1 || nCols == 1 ) {
// if ( !AddToDest )
// for ( uint ic = 0; ic < nCols; ++ ic )
// for ( uint ir = 0; ir < nRows; ++ ir )
// pOut[ir*iRowStO + ic*iColStO] = 0;
//
// for ( uint ic = 0; ic < nCols; ++ ic )
// for ( uint ir = 0; ir < nRows; ++ ir )
// for ( uint il = 0; il < nLink; ++ il )
// pOut[ir*iRowStO + ic*iColStO] += fFactor * pA[ir*iRowStA + il*iColStA] * pB[il*iRowStB + ic*iColStB];
// return;
// }
double
Beta = AddToDest? 1.0 : 0.0;
char
TransA, TransB;
FORTINT
lda, ldb,
ldc = (iRowStO == 1)? iColStO : iRowStO;
if ( iRowStA == 1 ) {
TransA = 'N'; lda = iColStA;
} else {
TransA = 'T'; lda = iRowStA;
}
if ( iRowStB == 1 ) {
TransB = 'N'; ldb = iColStB;
} else {
TransB = 'T'; ldb = iRowStB;
}
DGEMM( TransA, TransB, nRows, nCols, nLink,
fFactor, pA, lda, pB, ldb, Beta, pOut, ldc );
}
void IpBlasDgemm(bool transa, bool transb, Index m, Index n, Index k,
Number alpha, const Number* A, Index ldA, const Number* B,
Index ldB, Number beta, Number* C, Index ldC)
{
ipfint M=m, N=n, K=k, LDA=ldA, LDB=ldB, LDC=ldC;
char TRANSA;
if (transa) {
TRANSA = 'T';
}
else {
TRANSA = 'N';
}
char TRANSB;
if (transb) {
TRANSB = 'T';
}
else {
TRANSB = 'N';
}
DGEMM(&TRANSA, &TRANSB, &M, &N, &K, &alpha, A, &LDA,
B, &LDB, &beta, C, &LDC, 1, 1);
}
void Dgemm(double *A, double *B, double *C, int N) {
int M = N; int K = N;
double alpha = 1.0; double beta = 0.0;
int lda = N; int ldb = N; int ldc = N;
DGEMM("N", "N", &M, &N, &K, &alpha, A, &lda, B, &ldb, &beta, C, &ldc);
}
