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 
  8 using cxxblas::StorageUpLo;
  9 using cxxblas::Upper;
 10 using cxxblas::Lower;
 11 
 12 extern "C" {
 13 
 14     void xerbla_(const char* srname, int* info);
 15 
 16 #ifndef COMPLEX_FLOAT1
 17     typedef CBLAS_FLOAT                 CBLAS_ALPHA;
 18     typedef CBLAS_FLOAT                 CXXBLAS_FLOAT;
 19 #else
 20     typedef const CBLAS_FLOAT *         CBLAS_ALPHA;
 21     typedef std::complex<CBLAS_FLOAT>   CXXBLAS_FLOAT;
 22 #endif
 23 
 24     enum CBLAS_ORDER        {CblasRowMajor=101, CblasColMajor=102};
 25     enum CBLAS_UPLO         {CblasUpper=121, CblasLower=122};
 26 
 27     void
 28     CBLAS_NAME(enum CBLAS_ORDER _order,
 29                enum CBLAS_UPLO _upLo,
 30                CBLAS_INT n,
 31                CBLAS_ALPHA _alpha,
 32                const CBLAS_FLOAT *_x, CBLAS_INT incX,
 33                const CBLAS_FLOAT *_y, CBLAS_INT incY,
 34                CBLAS_FLOAT  *_A)
 35 #ifdef CREATE_CBLAS
 36     {
 37         StorageOrder order = (_order==CblasColMajor) ? ColMajor
 38                                                      : RowMajor;
 39         StorageUpLo upLo = Lower;
 40         if (_upLo==CblasUpper) {
 41             upLo = Upper;
 42         }
 43 
 44         const CXXBLAS_FLOAT *x = reinterpret_cast<const CXXBLAS_FLOAT *>(_x);
 45         const CXXBLAS_FLOAT *y = reinterpret_cast<const CXXBLAS_FLOAT *>(_y);
 46         CXXBLAS_FLOAT *A = reinterpret_cast<CXXBLAS_FLOAT *>(_A);
 47 
 48     #ifndef COMPLEX_FLOAT1
 49         CXXBLAS_FLOAT alpha = _alpha;
 50     #else
 51         CXXBLAS_FLOAT alpha(_alpha[0], _alpha[1]);
 52     #endif
 53 
 54         CXXBLAS_FLOAT *__A = A;
 55         StorageOrder __order = order;
 56 
 57 #   ifdef TEST_ROW_MAJOR
 58         __order = (order==ColMajor) ? RowMajor : ColMajor;
 59         allocatePackedStorage(n, __A);
 60         switchPackedStorageOrder(order, upLo, n, A, __A);
 61 #   endif
 62 
 63         cxxblas::hpr2(__order, upLo,
 64                       n,
 65                       alpha,
 66                       x, incX,
 67                       y, incY,
 68                       __A);
 69 
 70 #   ifdef TEST_ROW_MAJOR
 71         switchPackedStorageOrder(__order, upLo, n, __A, A);
 72         releaseStorage(__A);
 73 #   endif
 74     }
 75 #else
 76     ;
 77 #endif // CREATE_CBLAS
 78 
 79 #ifdef CREATE_BLAS
 80     void
 81     BLAS_NAME(const char *_upLo,
 82               const CBLAS_INT *_n,
 83               const CBLAS_FLOAT *_alpha,
 84               const CBLAS_FLOAT *x, const CBLAS_INT *_incX,
 85               const CBLAS_FLOAT *y, const CBLAS_INT *_incY,
 86               CBLAS_FLOAT *A)
 87     {
 88         bool checkUpLo = false;
 89         CBLAS_UPLO upLo = CblasUpper;
 90         if ((*_upLo=='L') || (*_upLo=='l')) {
 91             upLo = CblasLower;
 92             checkUpLo = true;
 93         }
 94         if ((*_upLo=='U') || (*_upLo=='u')) {
 95             checkUpLo = true;
 96         }
 97 
 98         CBLAS_INT n       = *_n;
 99         CBLAS_INT incX    = *_incX;
100         CBLAS_INT incY    = *_incY;
101 
102 #   ifndef COMPLEX_FLOAT1
103         CBLAS_ALPHA alpha  = *_alpha;
104 #   else
105         CBLAS_ALPHA alpha = _alpha;
106 #   endif
107 
108         CBLAS_INT info = 0;
109         if (incX==0) {
110             info = 5;
111         }
112         if (incY==0) {
113             info = 7;
114         }
115         if (n<0) {
116             info = 2;
117         }
118         if (!checkUpLo) {
119             info = 1;
120         }
121         if (info!=0) {
122             char blasName[6];
123             strncpy(blasName, BLAS_NAME_STR, 6);
124             for (int i=0; i<6; ++i) {
125                 blasName[i] = std::toupper(blasName[i]);
126             }
127             xerbla_(blasName, &info);
128           return;
129         }
130 
131         // the blas interface calls the cblas interface
132         // so any blas-test will also test the cblas-interface
133         CBLAS_NAME(CblasColMajor, upLo,
134                    n,
135                    alpha,
136                    x, incX,
137                    y, incY,
138                    A);
139     }
140 #endif // CREATE_BLAS
141 
142 } // extern "C"
Home