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