annotate ext/cblas/src/cblas_dgemm.c @ 211:a41bea655151 msvc

Rename FFT back again, now we have our own project
author Chris Cannam
date Mon, 05 Feb 2018 17:40:13 +0000
parents 45330e0d2819
children
rev   line source
Chris@202 1 /*
Chris@202 2 *
Chris@202 3 * cblas_dgemm.c
Chris@202 4 * This program is a C interface to dgemm.
Chris@202 5 * Written by Keita Teranishi
Chris@202 6 * 4/8/1998
Chris@202 7 *
Chris@202 8 */
Chris@202 9
Chris@202 10 #include "cblas.h"
Chris@202 11 #include "cblas_f77.h"
Chris@202 12 void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
Chris@202 13 const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
Chris@202 14 const int K, const double alpha, const double *A,
Chris@202 15 const int lda, const double *B, const int ldb,
Chris@202 16 const double beta, double *C, const int ldc)
Chris@202 17 {
Chris@202 18 char TA, TB;
Chris@202 19 #ifdef F77_CHAR
Chris@202 20 F77_CHAR F77_TA, F77_TB;
Chris@202 21 #else
Chris@202 22 #define F77_TA &TA
Chris@202 23 #define F77_TB &TB
Chris@202 24 #endif
Chris@202 25
Chris@202 26 #ifdef F77_INT
Chris@202 27 F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
Chris@202 28 F77_INT F77_ldc=ldc;
Chris@202 29 #else
Chris@202 30 #define F77_M M
Chris@202 31 #define F77_N N
Chris@202 32 #define F77_K K
Chris@202 33 #define F77_lda lda
Chris@202 34 #define F77_ldb ldb
Chris@202 35 #define F77_ldc ldc
Chris@202 36 #endif
Chris@202 37
Chris@202 38 extern int CBLAS_CallFromC;
Chris@202 39 extern int RowMajorStrg;
Chris@202 40 RowMajorStrg = 0;
Chris@202 41 CBLAS_CallFromC = 1;
Chris@202 42
Chris@202 43 if( Order == CblasColMajor )
Chris@202 44 {
Chris@202 45 if(TransA == CblasTrans) TA='T';
Chris@202 46 else if ( TransA == CblasConjTrans ) TA='C';
Chris@202 47 else if ( TransA == CblasNoTrans ) TA='N';
Chris@202 48 else
Chris@202 49 {
Chris@202 50 cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
Chris@202 51 CBLAS_CallFromC = 0;
Chris@202 52 RowMajorStrg = 0;
Chris@202 53 return;
Chris@202 54 }
Chris@202 55
Chris@202 56 if(TransB == CblasTrans) TB='T';
Chris@202 57 else if ( TransB == CblasConjTrans ) TB='C';
Chris@202 58 else if ( TransB == CblasNoTrans ) TB='N';
Chris@202 59 else
Chris@202 60 {
Chris@202 61 cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
Chris@202 62 CBLAS_CallFromC = 0;
Chris@202 63 RowMajorStrg = 0;
Chris@202 64 return;
Chris@202 65 }
Chris@202 66
Chris@202 67 #ifdef F77_CHAR
Chris@202 68 F77_TA = C2F_CHAR(&TA);
Chris@202 69 F77_TB = C2F_CHAR(&TB);
Chris@202 70 #endif
Chris@202 71
Chris@202 72 F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
Chris@202 73 &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
Chris@202 74 } else if (Order == CblasRowMajor)
Chris@202 75 {
Chris@202 76 RowMajorStrg = 1;
Chris@202 77 if(TransA == CblasTrans) TB='T';
Chris@202 78 else if ( TransA == CblasConjTrans ) TB='C';
Chris@202 79 else if ( TransA == CblasNoTrans ) TB='N';
Chris@202 80 else
Chris@202 81 {
Chris@202 82 cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
Chris@202 83 CBLAS_CallFromC = 0;
Chris@202 84 RowMajorStrg = 0;
Chris@202 85 return;
Chris@202 86 }
Chris@202 87 if(TransB == CblasTrans) TA='T';
Chris@202 88 else if ( TransB == CblasConjTrans ) TA='C';
Chris@202 89 else if ( TransB == CblasNoTrans ) TA='N';
Chris@202 90 else
Chris@202 91 {
Chris@202 92 cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
Chris@202 93 CBLAS_CallFromC = 0;
Chris@202 94 RowMajorStrg = 0;
Chris@202 95 return;
Chris@202 96 }
Chris@202 97 #ifdef F77_CHAR
Chris@202 98 F77_TA = C2F_CHAR(&TA);
Chris@202 99 F77_TB = C2F_CHAR(&TB);
Chris@202 100 #endif
Chris@202 101
Chris@202 102 F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
Chris@202 103 &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
Chris@202 104 }
Chris@202 105 else cblas_xerbla(1, "cblas_dgemm", "Illegal Order setting, %d\n", Order);
Chris@202 106 CBLAS_CallFromC = 0;
Chris@202 107 RowMajorStrg = 0;
Chris@202 108 return;
Chris@202 109 }