Home
Browse Files
  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,
 35                CBLAS_INT m, CBLAS_INT n,
 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         switchFullStorageOrder(order, m, n, A, ldA);
 70         order = (order==ColMajor) ? RowMajor : ColMajor;
 71 #   endif
 72 
 73         cxxblas::gemv(order, transA,
 74                       m, n,
 75                       alpha,
 76                       A, ldA,
 77                       x, incX,
 78                       beta,
 79                       y, incY);
 80 
 81 #   ifdef TEST_ROW_MAJOR
 82         releaseStorage(A);
 83 #   endif
 84     }
 85 #else
 86     ;
 87 #endif // CREATE_CBLAS
 88 
 89 #ifdef CREATE_BLAS
 90     void
 91     BLAS_NAME(const char *_transA,
 92               const CBLAS_INT *_m, const CBLAS_INT *_n,
 93               const CBLAS_FLOAT *_alpha,
 94               const CBLAS_FLOAT *A, const CBLAS_INT *_ldA,
 95               const CBLAS_FLOAT *x, const CBLAS_INT *_incX,
 96               const CBLAS_FLOAT *_beta,
 97               CBLAS_FLOAT *y, const CBLAS_INT *_incY)
 98     {
 99         CBLAS_TRANSPOSE transA;
100 
101         bool checkTransA = false;
102         if ((*_transA=='N') || (*_transA=='n')) {
103             transA = CblasNoTrans;
104             checkTransA = true;
105         }
106         if ((*_transA=='T') || (*_transA=='t')) {
107             transA = CblasTrans;
108             checkTransA = true;
109         }
110         if ((*_transA=='C') || (*_transA=='c')) {
111             transA = CblasConjTrans;
112             checkTransA = true;
113         }
114         if ((*_transA=='R') || (*_transA=='r')) {
115             transA = CblasConjNoTrans;
116             checkTransA = true;
117         }
118 
119         CBLAS_INT m       = *_m;
120         CBLAS_INT n       = *_n;
121         CBLAS_INT ldA     = *_ldA;
122         CBLAS_INT incX    = *_incX;
123         CBLAS_INT incY    = *_incY;
124 
125 #   ifndef COMPLEX_FLOAT1
126         CBLAS_ALPHA alpha  = *_alpha;
127         CBLAS_BETA beta  = *_beta;
128 #   else
129         CBLAS_ALPHA alpha = _alpha;
130         CBLAS_BETA beta = _beta;
131 #   endif
132 
133         CBLAS_INT info = 0;
134         if (incY==0) {
135             info = 11;
136         }
137         if (incX==0) {
138             info = 8; 
139         }
140         if (ldA<std::max(1, m)) {
141             info = 6;
142         }
143         if (n<0) {
144             info = 3;
145         }
146         if (m<0) {
147             info = 2;
148         }
149         if (!checkTransA) {
150             info = 1;
151         }
152         if (info!=0) {
153             char blasName[6];
154             strncpy(blasName, BLAS_NAME_STR, 6);
155             for (int i=0; i<6; ++i) {
156                 blasName[i] = std::toupper(blasName[i]);
157             }
158             xerbla_(blasName, &info);
159             return;
160         }
161 
162         // the blas interface calls the cblas interface
163         // so any blas-test will also test the cblas-interface
164         CBLAS_NAME(CblasColMajor, transA,
165                    m, n,
166                    alpha,
167                    A, ldA,
168                    x, incX,
169                    beta,
170                    y, incY);
171     }
172 #endif // CREATE_BLAS
173 
174 } // extern "C"
Home