annotate ext/cblas/src/cblas_dgemm.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +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 }