Home
Browse Files
  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                 CXXBLAS_FLOAT;
 24 #else
 25     typedef const CBLAS_FLOAT *         CBLAS_ALPHA;
 26     typedef std::complex<CBLAS_FLOAT>   CXXBLAS_FLOAT;
 27 #endif
 28 
 29     void
 30     CBLAS_NAME(enum CBLAS_ORDER _order,
 31                CBLAS_INT m, CBLAS_INT n,
 32                CBLAS_ALPHA _alpha,
 33                const CBLAS_FLOAT  *_x, CBLAS_INT incX,
 34                const CBLAS_FLOAT  *_y, CBLAS_INT incY,
 35                CBLAS_FLOAT  *_A, CBLAS_INT ldA)
 36 #ifdef CREATE_CBLAS
 37     {
 38         StorageOrder order = (_order==CblasColMajor) ? ColMajor
 39                                                      : RowMajor;
 40 
 41 
 42         const CXXBLAS_FLOAT *x = reinterpret_cast<const CXXBLAS_FLOAT *>(_x);
 43         const CXXBLAS_FLOAT *y = reinterpret_cast<const CXXBLAS_FLOAT *>(_y);
 44         CXXBLAS_FLOAT *A = reinterpret_cast<CXXBLAS_FLOAT *>(_A);
 45 
 46     #ifndef COMPLEX_FLOAT1
 47         CXXBLAS_FLOAT alpha = _alpha;
 48     #else
 49         CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
 50     #endif
 51 
 52         CXXBLAS_FLOAT *__A = A;
 53         CBLAS_INT      __ldA = ldA;
 54         StorageOrder   __order = order;
 55 
 56 #   ifdef TEST_ROW_MAJOR
 57         __order = (order==ColMajor) ? RowMajor : ColMajor;
 58         allocateFullStorage(__order, m, n, __A, __ldA);
 59         switchFullStorageOrder(order, m, n, A, ldA, __A, __ldA);
 60 #   endif
 61 
 62         cxxblas::ger(__order,
 63                      m, n,
 64                      alpha,
 65                      x, incX,
 66                      y, incY,
 67                      __A, __ldA);
 68 
 69 #   ifdef TEST_ROW_MAJOR
 70         switchFullStorageOrder(__order, m, n, __A, __ldA, A, ldA);
 71         releaseStorage(__A);
 72 #   endif
 73     }
 74 #else
 75     ;
 76 #endif // CREATE_CBLAS
 77 
 78 #ifdef CREATE_BLAS
 79     void
 80     BLAS_NAME(const CBLAS_INT *_m, const CBLAS_INT *_n,
 81               const CBLAS_FLOAT *_alpha,
 82               const CBLAS_FLOAT *x, const CBLAS_INT *_incX,
 83               const CBLAS_FLOAT *y, const CBLAS_INT *_incY,
 84               CBLAS_FLOAT *A, const CBLAS_INT *_ldA)
 85     {
 86         CBLAS_INT m       = *_m;
 87         CBLAS_INT n       = *_n;
 88         CBLAS_INT incX    = *_incX;
 89         CBLAS_INT incY    = *_incY;
 90         CBLAS_INT ldA     = *_ldA;
 91 
 92 #   ifndef COMPLEX_FLOAT1
 93         CBLAS_ALPHA alpha  = *_alpha;
 94 #   else
 95         CBLAS_ALPHA alpha = _alpha;
 96 #   endif
 97 
 98         CBLAS_INT info = 0;
 99         if (incY==0) {
100             info = 7;
101         }
102         if (incX==0) {
103             info = 5; 
104         }
105         if (ldA<std::max(1, m)) {
106             info = 9;
107         }
108         if (n<0) {
109             info = 2;
110         }
111         if (m<0) {
112             info = 1;
113         }
114         if (info!=0) {
115             char blasName[6];
116             strncpy(blasName, BLAS_NAME_STR, 6);
117             for (int i=0; i<6; ++i) {
118                 blasName[i] = std::toupper(blasName[i]);
119             }
120             xerbla_(blasName, &info);
121           return;
122         }
123 
124         // the blas interface calls the cblas interface
125         // so any blas-test will also test the cblas-interface
126         CBLAS_NAME(CblasColMajor,
127                    m, n,
128                    alpha,
129                    x, incX,
130                    y, incY,
131                    A, ldA);
132     }
133 #endif // CREATE_BLAS
134 
135 } // extern "C"
Home