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_SIDE _sideA,  enum CBLAS_UPLO _upLoA,
 45                CBLAS_INT m, CBLAS_INT n,
 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         Side        sideA = (_sideA==CblasLeft)  ? Left : Right;
 57         StorageUpLo upLoA = (_upLoA==CblasUpper) ? Upper : Lower;
 58 
 59         const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
 60         const CXXBLAS_FLOAT *B = reinterpret_cast<const CXXBLAS_FLOAT *>(_B);
 61         CXXBLAS_FLOAT *C = reinterpret_cast<CXXBLAS_FLOAT *>(_C);
 62 
 63 #   ifndef COMPLEX_FLOAT1
 64         CXXBLAS_FLOAT alpha = _alpha;
 65         CXXBLAS_FLOAT beta = _beta;
 66 #   else
 67         CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
 68         CXXBLAS_FLOAT beta(_beta[0], _beta[1]);
 69 #   endif
 70 
 71         CXXBLAS_FLOAT *__C = C;
 72         CBLAS_INT      __ldC = ldC;
 73         StorageOrder   __order = order;
 74 
 75 #   ifdef TEST_ROW_MAJOR
 76         CBLAS_INT   dimA =  (sideA==Left)        ? m : n;
 77 
 78         switchFullStorageOrder(order, dimA, dimA, A, ldA);
 79         switchFullStorageOrder(order, m, n, B, ldB);
 80 
 81         __order = (order==ColMajor) ? RowMajor : ColMajor;
 82         allocateFullStorage(__order, m, n, __C, __ldC);
 83         switchFullStorageOrder(order, m, n, C, ldC, __C, __ldC);
 84 #   endif
 85 
 86         cxxblas::hemm(__order, sideA, upLoA,
 87                       m, n,
 88                       alpha,
 89                       A, ldA,
 90                       B, ldB,
 91                       beta,
 92                       __C, __ldC);
 93 
 94 #   ifdef TEST_ROW_MAJOR
 95         releaseStorage(A);
 96         releaseStorage(B);
 97 
 98         switchFullStorageOrder(__order, m, n, __C, __ldC, C, ldC);
 99         releaseStorage(__C);
100 #   endif
101     }
102 #else
103     ;
104 #endif // CREATE_CBLAS
105 
106 
107 #ifdef CREATE_BLAS
108     void
109     BLAS_NAME(const char *_sideA, const char *_upLoA,
110               const CBLAS_INT *_m, const CBLAS_INT *_n,
111               const CBLAS_FLOAT *_alpha,
112               const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
113               const CBLAS_FLOAT *B, const CBLAS_INT *_ldB,
114               const CBLAS_FLOAT *_beta,
115               CBLAS_FLOAT *C, const CBLAS_INT *_ldC)
116     {
117         CBLAS_SIDE          sideA;
118         CBLAS_UPLO          upLoA;
119         CBLAS_INT           dimA  = -1;
120 
121         bool checkSideA = false;
122         bool checkUpLoA = false;
123 
124         CBLAS_INT m       = *_m;
125         CBLAS_INT n       = *_n;
126         CBLAS_INT ldA     = *_ldA;
127         CBLAS_INT ldB     = *_ldB;
128         CBLAS_INT ldC     = *_ldC;
129 
130         if (*_sideA=='L') {
131             sideA = CblasLeft;
132             dimA = m;
133             checkSideA = true;
134         }
135         if (*_sideA=='R') {
136             sideA = CblasRight;
137             dimA = n;
138             checkSideA = true;
139         }
140 
141         if ((*_upLoA=='L') || (*_upLoA=='l')) {
142             upLoA = CblasLower;
143             checkUpLoA = true;
144         }
145         if ((*_upLoA=='U') || (*_upLoA=='u')) {
146             upLoA = CblasUpper;
147             checkUpLoA = true;
148         }
149 
150 #   ifndef COMPLEX_FLOAT1
151         CBLAS_ALPHA alpha  = *_alpha;
152         CBLAS_BETA beta  = *_beta;
153 #   else
154         CBLAS_ALPHA alpha = _alpha;
155         CBLAS_ALPHA beta = _beta;
156 #   endif
157 
158         CBLAS_INT info = 0;
159         if (ldC<std::max(1, m)) {
160             info = 12;
161         }
162         if (ldB<std::max(1, m)) {
163             info = 9;
164         }
165         if (ldA<std::max(1, dimA)) {
166             info = 7;
167         }
168         if (n<0) {
169             info = 4;
170         }
171         if (m<0) {
172             info = 3;
173         }
174         if (!checkUpLoA) {
175             info = 2;
176         }
177         if (!checkSideA) {
178             info = 1;
179         }
180         if (info!=0) {
181             char blasName[6];
182             strncpy(blasName, BLAS_NAME_STR, 6);
183             for (int i=0; i<6; ++i) {
184                 blasName[i] = std::toupper(blasName[i]);
185             }
186             xerbla_(blasName, &info);
187             return;
188         }
189 
190         // the blas interface calls the cblas interface
191         // so any blas-test will also test the cblas-interface
192         CBLAS_NAME(CblasColMajor, sideA, upLoA,
193                    m, n,
194                    alpha,
195                    A, ldA,
196                    B, ldB,
197                    beta,
198                    C, ldC);
199     }
200 #endif // CREATE_BLAS
201 
202 // extern "C"