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 CBLAS_ALPHA;
34 typedef CBLAS_FLOAT CBLAS_BETA;
35 typedef CBLAS_FLOAT CXXBLAS_FLOAT;
36 #else
37 typedef const CBLAS_FLOAT * CBLAS_ALPHA;
38 typedef const CBLAS_FLOAT * CBLAS_BETA;
39 typedef std::complex<CBLAS_FLOAT> CXXBLAS_FLOAT;
40 #endif
41
42 void
43 CBLAS_NAME(enum CBLAS_ORDER _order,
44 enum CBLAS_UPLO _upLoC, enum CBLAS_TRANSPOSE _transA,
45 CBLAS_INT n, CBLAS_INT k,
46 CBLAS_ALPHA _alpha,
47 const CBLAS_FLOAT *_A, CBLAS_INT ldA,
48 CBLAS_BETA _beta,
49 CBLAS_FLOAT *_C, CBLAS_INT ldC)
50 #ifdef CREATE_CBLAS
51 {
52 StorageOrder order = (_order==CblasColMajor) ? ColMajor
53 : RowMajor;
54
55 StorageUpLo upLoC = (_upLoC==CblasUpper) ? Upper : Lower;
56
57 Transpose transA = NoTrans;
58 CBLAS_INT numRowsA = n;
59 CBLAS_INT numColsA = k;
60
61 if (_transA==CblasTrans) {
62 transA = Trans;
63 numRowsA = k;
64 numColsA = n;
65 }
66 if (_transA==CblasConjTrans) {
67 transA = ConjTrans;
68 numRowsA = k;
69 numColsA = n;
70 }
71 if (_transA==CblasConjNoTrans) {
72 transA = Conj;
73 numRowsA = n;
74 numColsA = k;
75 }
76
77 const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
78 CXXBLAS_FLOAT *C = reinterpret_cast<CXXBLAS_FLOAT *>(_C);
79
80 # ifndef COMPLEX_FLOAT1
81 CXXBLAS_FLOAT alpha = _alpha;
82 CXXBLAS_FLOAT beta = _beta;
83 # else
84 CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
85 CXXBLAS_FLOAT beta(_beta[0], _beta[1]);
86 # endif
87
88 CXXBLAS_FLOAT *__C = C;
89 CBLAS_INT __ldC = ldC;
90 StorageOrder __order = order;
91
92 # ifdef TEST_ROW_MAJOR
93 switchFullStorageOrder(order, numRowsA, numColsA, A, ldA);
94
95 __order = (order==ColMajor) ? RowMajor : ColMajor;
96 allocateFullStorage(__order, n, n, __C, __ldC);
97 switchFullStorageOrder(order, n, n, C, ldC, __C, __ldC);
98 # endif
99
100 cxxblas::syrk(__order, upLoC, transA,
101 n, k,
102 alpha,
103 A, ldA,
104 beta,
105 __C, __ldC);
106
107 # ifdef TEST_ROW_MAJOR
108 releaseStorage(A);
109
110 switchFullStorageOrder(__order, n, n, __C, __ldC, C, ldC);
111 releaseStorage(__C);
112 # endif
113 }
114 #else
115 ;
116 #endif // CREATE_CBLAS
117
118
119 #ifdef CREATE_BLAS
120 void
121 BLAS_NAME(const char *_upLoC, const char *_transA,
122 const CBLAS_INT *_n, const CBLAS_INT *_k,
123 const CBLAS_FLOAT *_alpha,
124 const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
125 const CBLAS_FLOAT *_beta,
126 CBLAS_FLOAT *C, const CBLAS_INT *_ldC)
127 {
128 CBLAS_UPLO upLoC;
129 CBLAS_TRANSPOSE transA;
130 CBLAS_INT numRowsA = -1;
131
132 bool checkUpLoC = false;
133 bool checkTransA = false;
134
135 CBLAS_INT n = *_n;
136 CBLAS_INT k = *_k;
137 CBLAS_INT ldA = *_ldA;
138 CBLAS_INT ldC = *_ldC;
139
140 if ((*_upLoC=='L') || (*_upLoC=='l')) {
141 upLoC = CblasLower;
142 checkUpLoC = true;
143 }
144 if ((*_upLoC=='U') || (*_upLoC=='u')) {
145 upLoC = CblasUpper;
146 checkUpLoC = true;
147 }
148
149 if ((*_transA=='N') || (*_transA=='n')) {
150 transA = CblasNoTrans;
151 numRowsA = n;
152 checkTransA = true;
153 }
154 if ((*_transA=='T') || (*_transA=='t')) {
155 transA = CblasTrans;
156 numRowsA = k;
157 checkTransA = true;
158 }
159 if ((*_transA=='C') || (*_transA=='c')) {
160 transA = CblasConjTrans;
161 numRowsA = k;
162 # ifndef COMPLEX_FLOAT1
163 checkTransA = true;
164 # else
165 checkTransA = false;
166 # endif
167 }
168 if ((*_transA=='R') || (*_transA=='r')) {
169 transA = CblasConjNoTrans;
170 numRowsA = n;
171 # ifndef COMPLEX_FLOAT1
172 checkTransA = true;
173 # else
174 checkTransA = false;
175 # endif
176 }
177
178
179 # ifndef COMPLEX_FLOAT1
180 CBLAS_ALPHA alpha = *_alpha;
181 CBLAS_BETA beta = *_beta;
182 # else
183 CBLAS_ALPHA alpha = _alpha;
184 CBLAS_ALPHA beta = _beta;
185 # endif
186
187 CBLAS_INT info = 0;
188 if (ldC<std::max(1, n)) {
189 info = 10;
190 }
191 if (ldA<std::max(1, numRowsA)) {
192 info = 7;
193 }
194 if (k<0) {
195 info = 4;
196 }
197 if (n<0) {
198 info = 3;
199 }
200 if (!checkTransA) {
201 info = 2;
202 }
203 if (!checkUpLoC) {
204 info = 1;
205 }
206 if (info!=0) {
207 char blasName[6];
208 strncpy(blasName, BLAS_NAME_STR, 6);
209 for (int i=0; i<6; ++i) {
210 blasName[i] = std::toupper(blasName[i]);
211 }
212 xerbla_(blasName, &info);
213 return;
214 }
215
216 // the blas interface calls the cblas interface
217 // so any blas-test will also test the cblas-interface
218 CBLAS_NAME(CblasColMajor, upLoC, transA,
219 n, k,
220 alpha,
221 A, ldA,
222 beta,
223 C, ldC);
224 }
225 #endif // CREATE_BLAS
226
227 } // 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 CBLAS_ALPHA;
34 typedef CBLAS_FLOAT CBLAS_BETA;
35 typedef CBLAS_FLOAT CXXBLAS_FLOAT;
36 #else
37 typedef const CBLAS_FLOAT * CBLAS_ALPHA;
38 typedef const CBLAS_FLOAT * CBLAS_BETA;
39 typedef std::complex<CBLAS_FLOAT> CXXBLAS_FLOAT;
40 #endif
41
42 void
43 CBLAS_NAME(enum CBLAS_ORDER _order,
44 enum CBLAS_UPLO _upLoC, enum CBLAS_TRANSPOSE _transA,
45 CBLAS_INT n, CBLAS_INT k,
46 CBLAS_ALPHA _alpha,
47 const CBLAS_FLOAT *_A, CBLAS_INT ldA,
48 CBLAS_BETA _beta,
49 CBLAS_FLOAT *_C, CBLAS_INT ldC)
50 #ifdef CREATE_CBLAS
51 {
52 StorageOrder order = (_order==CblasColMajor) ? ColMajor
53 : RowMajor;
54
55 StorageUpLo upLoC = (_upLoC==CblasUpper) ? Upper : Lower;
56
57 Transpose transA = NoTrans;
58 CBLAS_INT numRowsA = n;
59 CBLAS_INT numColsA = k;
60
61 if (_transA==CblasTrans) {
62 transA = Trans;
63 numRowsA = k;
64 numColsA = n;
65 }
66 if (_transA==CblasConjTrans) {
67 transA = ConjTrans;
68 numRowsA = k;
69 numColsA = n;
70 }
71 if (_transA==CblasConjNoTrans) {
72 transA = Conj;
73 numRowsA = n;
74 numColsA = k;
75 }
76
77 const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
78 CXXBLAS_FLOAT *C = reinterpret_cast<CXXBLAS_FLOAT *>(_C);
79
80 # ifndef COMPLEX_FLOAT1
81 CXXBLAS_FLOAT alpha = _alpha;
82 CXXBLAS_FLOAT beta = _beta;
83 # else
84 CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
85 CXXBLAS_FLOAT beta(_beta[0], _beta[1]);
86 # endif
87
88 CXXBLAS_FLOAT *__C = C;
89 CBLAS_INT __ldC = ldC;
90 StorageOrder __order = order;
91
92 # ifdef TEST_ROW_MAJOR
93 switchFullStorageOrder(order, numRowsA, numColsA, A, ldA);
94
95 __order = (order==ColMajor) ? RowMajor : ColMajor;
96 allocateFullStorage(__order, n, n, __C, __ldC);
97 switchFullStorageOrder(order, n, n, C, ldC, __C, __ldC);
98 # endif
99
100 cxxblas::syrk(__order, upLoC, transA,
101 n, k,
102 alpha,
103 A, ldA,
104 beta,
105 __C, __ldC);
106
107 # ifdef TEST_ROW_MAJOR
108 releaseStorage(A);
109
110 switchFullStorageOrder(__order, n, n, __C, __ldC, C, ldC);
111 releaseStorage(__C);
112 # endif
113 }
114 #else
115 ;
116 #endif // CREATE_CBLAS
117
118
119 #ifdef CREATE_BLAS
120 void
121 BLAS_NAME(const char *_upLoC, const char *_transA,
122 const CBLAS_INT *_n, const CBLAS_INT *_k,
123 const CBLAS_FLOAT *_alpha,
124 const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
125 const CBLAS_FLOAT *_beta,
126 CBLAS_FLOAT *C, const CBLAS_INT *_ldC)
127 {
128 CBLAS_UPLO upLoC;
129 CBLAS_TRANSPOSE transA;
130 CBLAS_INT numRowsA = -1;
131
132 bool checkUpLoC = false;
133 bool checkTransA = false;
134
135 CBLAS_INT n = *_n;
136 CBLAS_INT k = *_k;
137 CBLAS_INT ldA = *_ldA;
138 CBLAS_INT ldC = *_ldC;
139
140 if ((*_upLoC=='L') || (*_upLoC=='l')) {
141 upLoC = CblasLower;
142 checkUpLoC = true;
143 }
144 if ((*_upLoC=='U') || (*_upLoC=='u')) {
145 upLoC = CblasUpper;
146 checkUpLoC = true;
147 }
148
149 if ((*_transA=='N') || (*_transA=='n')) {
150 transA = CblasNoTrans;
151 numRowsA = n;
152 checkTransA = true;
153 }
154 if ((*_transA=='T') || (*_transA=='t')) {
155 transA = CblasTrans;
156 numRowsA = k;
157 checkTransA = true;
158 }
159 if ((*_transA=='C') || (*_transA=='c')) {
160 transA = CblasConjTrans;
161 numRowsA = k;
162 # ifndef COMPLEX_FLOAT1
163 checkTransA = true;
164 # else
165 checkTransA = false;
166 # endif
167 }
168 if ((*_transA=='R') || (*_transA=='r')) {
169 transA = CblasConjNoTrans;
170 numRowsA = n;
171 # ifndef COMPLEX_FLOAT1
172 checkTransA = true;
173 # else
174 checkTransA = false;
175 # endif
176 }
177
178
179 # ifndef COMPLEX_FLOAT1
180 CBLAS_ALPHA alpha = *_alpha;
181 CBLAS_BETA beta = *_beta;
182 # else
183 CBLAS_ALPHA alpha = _alpha;
184 CBLAS_ALPHA beta = _beta;
185 # endif
186
187 CBLAS_INT info = 0;
188 if (ldC<std::max(1, n)) {
189 info = 10;
190 }
191 if (ldA<std::max(1, numRowsA)) {
192 info = 7;
193 }
194 if (k<0) {
195 info = 4;
196 }
197 if (n<0) {
198 info = 3;
199 }
200 if (!checkTransA) {
201 info = 2;
202 }
203 if (!checkUpLoC) {
204 info = 1;
205 }
206 if (info!=0) {
207 char blasName[6];
208 strncpy(blasName, BLAS_NAME_STR, 6);
209 for (int i=0; i<6; ++i) {
210 blasName[i] = std::toupper(blasName[i]);
211 }
212 xerbla_(blasName, &info);
213 return;
214 }
215
216 // the blas interface calls the cblas interface
217 // so any blas-test will also test the cblas-interface
218 CBLAS_NAME(CblasColMajor, upLoC, transA,
219 n, k,
220 alpha,
221 A, ldA,
222 beta,
223 C, ldC);
224 }
225 #endif // CREATE_BLAS
226
227 } // extern "C"