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