1 #include <cxxblas/cxxblas.cxx>
2 #include <cxxblas/interface/aux.h>
3 #include <complex>
4
5 using cxxblas::StorageOrder;
6 using cxxblas::ColMajor;
7 using cxxblas::RowMajor;
8 using cxxblas::Transpose;
9 using cxxblas::NoTrans;
10 using cxxblas::Trans;
11 using cxxblas::Conj;
12 using cxxblas::ConjTrans;
13 using cxxblas::Side;
14 using cxxblas::Left;
15 using cxxblas::Right;
16 using cxxblas::Diag;
17 using cxxblas::Unit;
18 using cxxblas::NonUnit;
19
20
21 extern "C" {
22
23 void xerbla_(const char* srname, int* info);
24
25 enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
26 enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112,
27 CblasConjTrans=113, CblasConjNoTrans=114};
28 enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
29 enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
30 enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
31
32 #ifndef COMPLEX_FLOAT1
33 typedef CBLAS_FLOAT CXXBLAS_FLOAT;
34 #else
35 typedef std::complex<CBLAS_FLOAT> CXXBLAS_FLOAT;
36 #endif
37
38 void
39 CBLAS_NAME(enum CBLAS_ORDER _order,
40 enum CBLAS_UPLO _upLoC, enum CBLAS_TRANSPOSE _transA,
41 CBLAS_INT n, CBLAS_INT k,
42 CBLAS_FLOAT _alpha,
43 const CBLAS_FLOAT *_A, CBLAS_INT ldA,
44 CBLAS_FLOAT _beta,
45 CBLAS_FLOAT *_C, CBLAS_INT ldC)
46 #ifdef CREATE_CBLAS
47 {
48 StorageOrder order = (_order==CblasColMajor) ? ColMajor
49 : RowMajor;
50
51 StorageUpLo upLoC = (_upLoC==CblasUpper) ? Upper : Lower;
52
53 Transpose transA = NoTrans;
54 CBLAS_INT numRowsA = n;
55 CBLAS_INT numColsA = k;
56
57 if (_transA==CblasTrans) {
58 transA = Trans;
59 numRowsA = k;
60 numColsA = n;
61 }
62 if (_transA==CblasConjTrans) {
63 transA = ConjTrans;
64 numRowsA = k;
65 numColsA = n;
66 }
67 if (_transA==CblasConjNoTrans) {
68 transA = Conj;
69 numRowsA = n;
70 numColsA = k;
71 }
72
73 const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
74 CXXBLAS_FLOAT *C = reinterpret_cast<CXXBLAS_FLOAT *>(_C);
75
76 CBLAS_FLOAT alpha = _alpha;
77 CBLAS_FLOAT beta = _beta;
78
79 CXXBLAS_FLOAT *__C = C;
80 CBLAS_INT __ldC = ldC;
81 StorageOrder __order = order;
82
83 # ifdef TEST_ROW_MAJOR
84 switchFullStorageOrder(order, numRowsA, numColsA, A, ldA);
85
86 __order = (order==ColMajor) ? RowMajor : ColMajor;
87 allocateFullStorage(__order, n, n, __C, __ldC);
88 switchFullStorageOrder(order, n, n, C, ldC, __C, __ldC);
89 # endif
90
91 cxxblas::herk(__order, upLoC, transA,
92 n, k,
93 alpha,
94 A, ldA,
95 beta,
96 __C, __ldC);
97
98 # ifdef TEST_ROW_MAJOR
99 releaseStorage(A);
100
101 switchFullStorageOrder(__order, n, n, __C, __ldC, C, ldC);
102 releaseStorage(__C);
103 # endif
104 }
105 #else
106 ;
107 #endif // CREATE_CBLAS
108
109
110 #ifdef CREATE_BLAS
111 void
112 BLAS_NAME(const char *_upLoC, const char *_transA,
113 const CBLAS_INT *_n, const CBLAS_INT *_k,
114 const CBLAS_FLOAT *_alpha,
115 const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
116 const CBLAS_FLOAT *_beta,
117 CBLAS_FLOAT *C, const CBLAS_INT *_ldC)
118 {
119 CBLAS_UPLO upLoC;
120 CBLAS_TRANSPOSE transA;
121 CBLAS_INT numRowsA = -1;
122
123 bool checkUpLoC = false;
124 bool checkTransA = false;
125
126 CBLAS_INT n = *_n;
127 CBLAS_INT k = *_k;
128 CBLAS_INT ldA = *_ldA;
129 CBLAS_INT ldC = *_ldC;
130 CBLAS_FLOAT alpha = *_alpha;
131 CBLAS_FLOAT beta = *_beta;
132
133 if ((*_upLoC=='L') || (*_upLoC=='l')) {
134 upLoC = CblasLower;
135 checkUpLoC = true;
136 }
137 if ((*_upLoC=='U') || (*_upLoC=='u')) {
138 upLoC = CblasUpper;
139 checkUpLoC = true;
140 }
141
142 if ((*_transA=='N') || (*_transA=='n')) {
143 transA = CblasNoTrans;
144 numRowsA = n;
145 checkTransA = true;
146 }
147 if ((*_transA=='T') || (*_transA=='t')) {
148 transA = CblasTrans;
149 numRowsA = k;
150 checkTransA = false; // 'T' is illegal
151 }
152 if ((*_transA=='C') || (*_transA=='c')) {
153 transA = CblasConjTrans;
154 numRowsA = k;
155 checkTransA = true;
156 }
157 if ((*_transA=='R') || (*_transA=='r')) {
158 transA = CblasConjNoTrans;
159 numRowsA = n;
160 checkTransA = false; // 'R' is illegal
161 }
162
163 CBLAS_INT info = 0;
164 if (ldC<std::max(1, n)) {
165 info = 10;
166 }
167 if (ldA<std::max(1, numRowsA)) {
168 info = 7;
169 }
170 if (k<0) {
171 info = 4;
172 }
173 if (n<0) {
174 info = 3;
175 }
176 if (!checkTransA) {
177 info = 2;
178 }
179 if (!checkUpLoC) {
180 info = 1;
181 }
182 if (info!=0) {
183 char blasName[6];
184 strncpy(blasName, BLAS_NAME_STR, 6);
185 for (int i=0; i<6; ++i) {
186 blasName[i] = std::toupper(blasName[i]);
187 }
188 xerbla_(blasName, &info);
189 return;
190 }
191
192 // the blas interface calls the cblas interface
193 // so any blas-test will also test the cblas-interface
194 CBLAS_NAME(CblasColMajor, upLoC, transA,
195 n, k,
196 alpha,
197 A, ldA,
198 beta,
199 C, ldC);
200 }
201 #endif // CREATE_BLAS
202
203 } // extern "C"
2 #include <cxxblas/interface/aux.h>
3 #include <complex>
4
5 using cxxblas::StorageOrder;
6 using cxxblas::ColMajor;
7 using cxxblas::RowMajor;
8 using cxxblas::Transpose;
9 using cxxblas::NoTrans;
10 using cxxblas::Trans;
11 using cxxblas::Conj;
12 using cxxblas::ConjTrans;
13 using cxxblas::Side;
14 using cxxblas::Left;
15 using cxxblas::Right;
16 using cxxblas::Diag;
17 using cxxblas::Unit;
18 using cxxblas::NonUnit;
19
20
21 extern "C" {
22
23 void xerbla_(const char* srname, int* info);
24
25 enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
26 enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112,
27 CblasConjTrans=113, CblasConjNoTrans=114};
28 enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
29 enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
30 enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
31
32 #ifndef COMPLEX_FLOAT1
33 typedef CBLAS_FLOAT CXXBLAS_FLOAT;
34 #else
35 typedef std::complex<CBLAS_FLOAT> CXXBLAS_FLOAT;
36 #endif
37
38 void
39 CBLAS_NAME(enum CBLAS_ORDER _order,
40 enum CBLAS_UPLO _upLoC, enum CBLAS_TRANSPOSE _transA,
41 CBLAS_INT n, CBLAS_INT k,
42 CBLAS_FLOAT _alpha,
43 const CBLAS_FLOAT *_A, CBLAS_INT ldA,
44 CBLAS_FLOAT _beta,
45 CBLAS_FLOAT *_C, CBLAS_INT ldC)
46 #ifdef CREATE_CBLAS
47 {
48 StorageOrder order = (_order==CblasColMajor) ? ColMajor
49 : RowMajor;
50
51 StorageUpLo upLoC = (_upLoC==CblasUpper) ? Upper : Lower;
52
53 Transpose transA = NoTrans;
54 CBLAS_INT numRowsA = n;
55 CBLAS_INT numColsA = k;
56
57 if (_transA==CblasTrans) {
58 transA = Trans;
59 numRowsA = k;
60 numColsA = n;
61 }
62 if (_transA==CblasConjTrans) {
63 transA = ConjTrans;
64 numRowsA = k;
65 numColsA = n;
66 }
67 if (_transA==CblasConjNoTrans) {
68 transA = Conj;
69 numRowsA = n;
70 numColsA = k;
71 }
72
73 const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
74 CXXBLAS_FLOAT *C = reinterpret_cast<CXXBLAS_FLOAT *>(_C);
75
76 CBLAS_FLOAT alpha = _alpha;
77 CBLAS_FLOAT beta = _beta;
78
79 CXXBLAS_FLOAT *__C = C;
80 CBLAS_INT __ldC = ldC;
81 StorageOrder __order = order;
82
83 # ifdef TEST_ROW_MAJOR
84 switchFullStorageOrder(order, numRowsA, numColsA, A, ldA);
85
86 __order = (order==ColMajor) ? RowMajor : ColMajor;
87 allocateFullStorage(__order, n, n, __C, __ldC);
88 switchFullStorageOrder(order, n, n, C, ldC, __C, __ldC);
89 # endif
90
91 cxxblas::herk(__order, upLoC, transA,
92 n, k,
93 alpha,
94 A, ldA,
95 beta,
96 __C, __ldC);
97
98 # ifdef TEST_ROW_MAJOR
99 releaseStorage(A);
100
101 switchFullStorageOrder(__order, n, n, __C, __ldC, C, ldC);
102 releaseStorage(__C);
103 # endif
104 }
105 #else
106 ;
107 #endif // CREATE_CBLAS
108
109
110 #ifdef CREATE_BLAS
111 void
112 BLAS_NAME(const char *_upLoC, const char *_transA,
113 const CBLAS_INT *_n, const CBLAS_INT *_k,
114 const CBLAS_FLOAT *_alpha,
115 const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
116 const CBLAS_FLOAT *_beta,
117 CBLAS_FLOAT *C, const CBLAS_INT *_ldC)
118 {
119 CBLAS_UPLO upLoC;
120 CBLAS_TRANSPOSE transA;
121 CBLAS_INT numRowsA = -1;
122
123 bool checkUpLoC = false;
124 bool checkTransA = false;
125
126 CBLAS_INT n = *_n;
127 CBLAS_INT k = *_k;
128 CBLAS_INT ldA = *_ldA;
129 CBLAS_INT ldC = *_ldC;
130 CBLAS_FLOAT alpha = *_alpha;
131 CBLAS_FLOAT beta = *_beta;
132
133 if ((*_upLoC=='L') || (*_upLoC=='l')) {
134 upLoC = CblasLower;
135 checkUpLoC = true;
136 }
137 if ((*_upLoC=='U') || (*_upLoC=='u')) {
138 upLoC = CblasUpper;
139 checkUpLoC = true;
140 }
141
142 if ((*_transA=='N') || (*_transA=='n')) {
143 transA = CblasNoTrans;
144 numRowsA = n;
145 checkTransA = true;
146 }
147 if ((*_transA=='T') || (*_transA=='t')) {
148 transA = CblasTrans;
149 numRowsA = k;
150 checkTransA = false; // 'T' is illegal
151 }
152 if ((*_transA=='C') || (*_transA=='c')) {
153 transA = CblasConjTrans;
154 numRowsA = k;
155 checkTransA = true;
156 }
157 if ((*_transA=='R') || (*_transA=='r')) {
158 transA = CblasConjNoTrans;
159 numRowsA = n;
160 checkTransA = false; // 'R' is illegal
161 }
162
163 CBLAS_INT info = 0;
164 if (ldC<std::max(1, n)) {
165 info = 10;
166 }
167 if (ldA<std::max(1, numRowsA)) {
168 info = 7;
169 }
170 if (k<0) {
171 info = 4;
172 }
173 if (n<0) {
174 info = 3;
175 }
176 if (!checkTransA) {
177 info = 2;
178 }
179 if (!checkUpLoC) {
180 info = 1;
181 }
182 if (info!=0) {
183 char blasName[6];
184 strncpy(blasName, BLAS_NAME_STR, 6);
185 for (int i=0; i<6; ++i) {
186 blasName[i] = std::toupper(blasName[i]);
187 }
188 xerbla_(blasName, &info);
189 return;
190 }
191
192 // the blas interface calls the cblas interface
193 // so any blas-test will also test the cblas-interface
194 CBLAS_NAME(CblasColMajor, upLoC, transA,
195 n, k,
196 alpha,
197 A, ldA,
198 beta,
199 C, ldC);
200 }
201 #endif // CREATE_BLAS
202
203 } // extern "C"