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