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