void accel_multMatrix(double* m1,double* m2, int ndata,int ndata2,int npol, double* out){
int m,n,k;
double alpha=1.0,beta=0;
m=npol;
n=ndata;
k=ndata2;
/*
* An important note about this. FORTRAN effectively transposes all matricies becaue
* the memory is ordered differently.
*
* Therefore, to compute C=A.B we do C=B.A where there is an implicit transpose of all three
* matricies.
*
* M.Keith 2013.
*/
F77_dgemm("N","N",&m,&n,&k,&alpha,m2,&m,m1,&k,&beta,out,&m);
/*
m=ndata;
n=npol;
k=ndata;
F77_dgemm("N","T",&m,&n,&k,&alpha,m1,&m,m2,&n,&beta,out,&m);
*/
}
void bl1_dgemm_blas( trans1_t transa, trans1_t transb, int m, int n, int k, double* alpha, double* a, int lda, double* b, int ldb, double* beta, double* c, int ldc )
{
#ifdef BLIS1_ENABLE_CBLAS_INTERFACES
enum CBLAS_ORDER cblas_order = CblasColMajor;
enum CBLAS_TRANSPOSE cblas_transa;
enum CBLAS_TRANSPOSE cblas_transb;
bl1_param_map_to_netlib_trans( transa, &cblas_transa );
bl1_param_map_to_netlib_trans( transb, &cblas_transb );
cblas_dgemm( cblas_order,
cblas_transa,
cblas_transb,
m,
n,
k,
*alpha,
a, lda,
b, ldb,
*beta,
c, ldc );
#else
char blas_transa;
char blas_transb;
bl1_param_map_to_netlib_trans( transa, &blas_transa );
bl1_param_map_to_netlib_trans( transb, &blas_transb );
F77_dgemm( &blas_transa,
&blas_transb,
&m,
&n,
&k,
alpha,
a, &lda,
b, &ldb,
beta,
c, &ldc );
#endif
}
void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE 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)
{
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
extern int CBLAS_CallFromC;
extern int RowMajorStrg;
RowMajorStrg = 0;
CBLAS_CallFromC = 1;
if( layout == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
&F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (layout == CblasRowMajor)
{
RowMajorStrg = 1;
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
&F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_dgemm", "Illegal layout setting, %d\n", layout);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
void OpenMPBLAS3::gemm(
const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB,
const IndexType m,
const IndexType n,
const IndexType k,
const double alpha,
const double* A,
const IndexType lda,
const double* B,
const IndexType ldb,
const double beta,
double* C,
const IndexType ldc,
SyncToken* syncToken )
{
if ( syncToken )
{
LAMA_LOG_WARN( logger, "no asynchronous execution for openmp possible at this level." )
}
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M = m, F77_N = n, F77_K = k, F77_lda = lda, F77_ldb = ldb;
F77_INT F77_ldc = ldc;
#else
#define F77_M m
#define F77_N n
#define F77_K k
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
IndexType RowMajorStrg;
RowMajorStrg = 0;
if ( order == CblasColMajor )
{
if ( TransA == CblasTrans )
{
TA = 'T';
}
else if ( TransA == CblasConjTrans )
{
TA = 'C';
}
else if ( TransA == CblasNoTrans )
{
TA = 'N';
}
else
{
BLASHelper::XERBLA_cpu( RowMajorStrg, 2, "cblas_dgemm", "Illegal TransA setting, %d\n", TransA );
RowMajorStrg = 0;
return;
}
if ( TransB == CblasTrans )
{
TB = 'T';
}
else if ( TransB == CblasConjTrans )
{
TB = 'C';
}
else if ( TransB == CblasNoTrans )
{
TB = 'N';
}
else
{
BLASHelper::XERBLA_cpu( RowMajorStrg, 3, "cblas_dgemm", "Illegal TransB setting, %d\n", TransB );
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR( &TA );
F77_TB = C2F_CHAR( &TB );
#endif
F77_dgemm( F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc );
}
else if ( order == CblasRowMajor )
{
RowMajorStrg = 1;
if ( TransA == CblasTrans )
{
TB = 'T';
}
else if ( TransA == CblasConjTrans )
{
TB = 'C';
}
else if ( TransA == CblasNoTrans )
{
TB = 'N';
}
else
{
BLASHelper::XERBLA_cpu( RowMajorStrg, 2, "cblas_dgemm", "Illegal TransA setting, %d\n", TransA );
RowMajorStrg = 0;
return;
}
if ( TransB == CblasTrans )
{
TA = 'T';
}
else if ( TransB == CblasConjTrans )
{
TA = 'C';
}
else if ( TransB == CblasNoTrans )
{
TA = 'N';
}
else
{
BLASHelper::XERBLA_cpu( RowMajorStrg, 2, "cblas_dgemm", "Illegal TransB setting, %d\n", TransB );
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR( &TA );
F77_TB = C2F_CHAR( &TB );
#endif
F77_dgemm( F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc );
}
else
{
BLASHelper::XERBLA_cpu( RowMajorStrg, 1, "cblas_dgemm", "Illegal order setting, %d\n", order );
}
RowMajorStrg = 0;
return;
}
int main (int argc, char **argv )
{
int rout=-1,info=0,m,n,k,lda,ldb,ldc;
double A[2] = {0.0,0.0},
B[2] = {0.0,0.0},
C[2] = {0.0,0.0},
ALPHA=0.0, BETA=0.0;
if (argc > 2){
rout = atoi(argv[1]);
info = atoi(argv[2]);
}
if (rout == 1) {
if (info==0) {
printf("Checking if cblas_dgemm fails on parameter 4\n");
cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0,
ALPHA, A, 1, B, 1, BETA, C, 1 );
}
if (info==1) {
printf("Checking if cblas_dgemm fails on parameter 5\n");
cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0,
ALPHA, A, 1, B, 1, BETA, C, 1 );
}
if (info==2) {
printf("Checking if cblas_dgemm fails on parameter 9\n");
cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2,
ALPHA, A, 1, B, 1, BETA, C, 2 );
}
if (info==3) {
printf("Checking if cblas_dgemm fails on parameter 11\n");
cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 2,
ALPHA, A, 1, B, 1, BETA, C, 1 );
}
} else {
if (info==0) {
printf("Checking if F77_dgemm fails on parameter 3\n");
m=INVALID; n=0; k=0; lda=1; ldb=1; ldc=1;
F77_dgemm( "T", "N", &m, &n, &k,
&ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc );
}
if (info==1) {
m=0; n=INVALID; k=0; lda=1; ldb=1; ldc=1;
printf("Checking if F77_dgemm fails on parameter 4\n");
F77_dgemm( "N", "T", &m, &n, &k,
&ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc );
}
if (info==2) {
printf("Checking if F77_dgemm fails on parameter 8\n");
m=2; n=0; k=0; lda=1; ldb=1; ldc=2;
F77_dgemm( "N", "N" , &m, &n, &k,
&ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc );
}
if (info==3) {
printf("Checking if F77_dgemm fails on parameter 10\n");
m=0; n=0; k=2; lda=1; ldb=1; ldc=1;
F77_dgemm( "N", "N" , &m, &n, &k,
&ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc );
}
}
return 1;
}
