1 #include <cxxblas/cxxblas.cxx>
  2 #include <cxxblas/interface/aux.h>
  3 
  4 using cxxblas::StorageOrder;
  5 using cxxblas::ColMajor;
  6 using cxxblas::RowMajor;
  7 using cxxblas::Transpose;
  8 using cxxblas::NoTrans;
  9 using cxxblas::Trans;
 10 using cxxblas::Conj;
 11 using cxxblas::ConjTrans;
 12 
 13 extern "C" {
 14 
 15     void xerbla_(const char* srname, int* info);
 16 
 17     enum CBLAS_ORDER        {CblasRowMajor=101, CblasColMajor=102};
 18     enum CBLAS_TRANSPOSE    {CblasNoTrans=111, CblasTrans=112,
 19                              CblasConjTrans=113, CblasConjNoTrans=114};
 20 
 21 #ifndef COMPLEX_FLOAT1
 22     typedef CBLAS_FLOAT                 CBLAS_ALPHA;
 23     typedef CBLAS_FLOAT                 CBLAS_BETA;
 24     typedef CBLAS_FLOAT                 CXXBLAS_FLOAT;
 25 #else
 26     typedef const CBLAS_FLOAT *         CBLAS_ALPHA;
 27     typedef const CBLAS_FLOAT *         CBLAS_BETA;
 28     typedef std::complex<CBLAS_FLOAT>   CXXBLAS_FLOAT;
 29 #endif
 30 
 31     void
 32     CBLAS_NAME(enum CBLAS_ORDER _order,
 33                enum CBLAS_TRANSPOSE _transA,
 34                CBLAS_INT m, CBLAS_INT n,
 35                CBLAS_INT kl, CBLAS_INT ku,
 36                CBLAS_ALPHA _alpha,
 37                const CBLAS_FLOAT  *_A, CBLAS_INT ldA,
 38                const CBLAS_FLOAT  *_x, CBLAS_INT incX,
 39                CBLAS_BETA _beta,
 40                CBLAS_FLOAT  *_y, CBLAS_INT incY)
 41 #ifdef CREATE_CBLAS
 42     {
 43         StorageOrder order = (_order==CblasColMajor) ? ColMajor
 44                                                      : RowMajor;
 45         Transpose transA = NoTrans;
 46         if (_transA==CblasTrans) {
 47             transA = Trans;
 48         }
 49         if (_transA==CblasConjTrans) {
 50             transA = ConjTrans;
 51         }
 52         if (_transA==CblasConjNoTrans) {
 53             transA = Conj;
 54         }
 55 
 56         const CXXBLAS_FLOAT *A = reinterpret_cast<const CXXBLAS_FLOAT *>(_A);
 57         const CXXBLAS_FLOAT *x = reinterpret_cast<const CXXBLAS_FLOAT *>(_x);
 58         CXXBLAS_FLOAT *y = reinterpret_cast<CXXBLAS_FLOAT *>(_y);
 59 
 60     #ifndef COMPLEX_FLOAT1
 61         CXXBLAS_FLOAT alpha = _alpha;
 62         CXXBLAS_FLOAT beta = _beta;
 63     #else
 64         CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
 65         CXXBLAS_FLOAT beta(_beta[0], _beta[1]);
 66     #endif
 67 
 68 #   ifdef TEST_ROW_MAJOR
 69         switchBandStorageOrder(order, m, n, kl, ku, A, ldA);
 70         order = (order==ColMajor) ? RowMajor : ColMajor;
 71 #   endif
 72 
 73         cxxblas::gbmv(order, transA,
 74                       m, n,
 75                       kl, ku,
 76                       alpha,
 77                       A, ldA,
 78                       x, incX,
 79                       beta,
 80                       y, incY);
 81 
 82 #   ifdef TEST_ROW_MAJOR
 83         releaseStorage(A);
 84 #   endif
 85     }
 86 #else
 87     ;
 88 #endif // CREATE_CBLAS
 89 
 90 #ifdef CREATE_BLAS
 91     void
 92     BLAS_NAME(const char *_transA,
 93               const CBLAS_INT *_m, const CBLAS_INT *_n,
 94               const CBLAS_INT *_kl, const CBLAS_INT *_ku,
 95               const CBLAS_FLOAT *_alpha,
 96               const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
 97               const CBLAS_FLOAT *x, const CBLAS_INT *_incX,
 98               const CBLAS_FLOAT *_beta,
 99               CBLAS_FLOAT *y, const CBLAS_INT *_incY)
100     {
101         bool checkTransA = false;
102         CBLAS_TRANSPOSE transA = CblasConjNoTrans;
103 
104         if ((*_transA=='N') || (*_transA=='n')) {
105             checkTransA = true;
106             transA = CblasNoTrans;
107         }
108         if ((*_transA=='T') || (*_transA=='t')) {
109             checkTransA = true;
110             transA = CblasTrans;
111         }
112         if ((*_transA=='C') || (*_transA=='c')) {
113             checkTransA = true;
114             transA = CblasConjTrans;
115         }
116         if ((*_transA=='R') || (*_transA=='r')) {
117             checkTransA = true;
118             transA = CblasConjNoTrans;
119         }
120 
121         CBLAS_INT m       = *_m;
122         CBLAS_INT n       = *_n;
123         CBLAS_INT kl      = *_kl;
124         CBLAS_INT ku      = *_ku;
125         CBLAS_INT ldA     = *_ldA;
126         CBLAS_INT incX    = *_incX;
127         CBLAS_INT incY    = *_incY;
128 
129 #   ifndef COMPLEX_FLOAT1
130         CBLAS_ALPHA alpha  = *_alpha;
131         CBLAS_BETA beta  = *_beta;
132 #   else
133         CBLAS_ALPHA alpha = _alpha;
134         CBLAS_BETA beta = _beta;
135 #   endif
136 
137         CBLAS_INT info = 0;
138         if (incY==0) {
139             info = 13;
140         }
141         if (incX==0) {
142             info = 10
143         }
144         if (ldA<ku+kl+1) {
145             info = 8;
146         }
147         if (kl<0) {
148             info = 4;
149         }
150         if (ku<0) {
151             info = 5;
152         }
153         if (n<0) {
154             info = 3;
155         }
156         if (m<0) {
157             info = 2;
158         }
159         if (!checkTransA) {
160             info = 1;
161         }
162         if (info!=0) {
163             char blasName[6];
164             strncpy(blasName, BLAS_NAME_STR, 6);
165             for (int i=0; i<6; ++i) {
166                 blasName[i] = std::toupper(blasName[i]);
167             }
168             xerbla_(blasName, &info);
169           return;
170         }
171 
172         // the blas interface calls the cblas interface
173         // so any blas-test will also test the cblas-interface
174         CBLAS_NAME(CblasColMajor, transA,
175                    m, n,
176                    kl, ku,
177                    alpha,
178                    A, ldA,
179                    x, incX,
180                    beta,
181                    y, incY);
182     }
183 #endif // CREATE_BLAS
184 
185 // extern "C"