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, CBLAS_INT ldA)
 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         CBLAS_INT      __ldA = ldA;
 56         StorageOrder   __order = order;
 57 
 58 #   ifdef TEST_ROW_MAJOR
 59         __order = (order==ColMajor) ? RowMajor : ColMajor;
 60         allocateFullStorage(__order, n, n, __A, __ldA);
 61         switchFullStorageOrder(order, n, n, A, ldA, __A, __ldA);
 62 #   endif
 63 
 64         cxxblas::her2(__order, upLo,
 65                       n,
 66                       alpha,
 67                       x, incX,
 68                       y, incY,
 69                       __A, __ldA);
 70 
 71 #   ifdef TEST_ROW_MAJOR
 72         switchFullStorageOrder(__order, n, n, __A, __ldA, A, ldA);
 73         releaseStorage(__A);
 74 #   endif
 75     }
 76 #else
 77     ;
 78 #endif // CREATE_CBLAS
 79 
 80 #ifdef CREATE_BLAS
 81     void
 82     BLAS_NAME(const char *_upLo,
 83               const CBLAS_INT *_n,
 84               const CBLAS_FLOAT *_alpha,
 85               const CBLAS_FLOAT *x, const CBLAS_INT *_incX,
 86               const CBLAS_FLOAT *y, const CBLAS_INT *_incY,
 87               CBLAS_FLOAT *A, const CBLAS_INT *_ldA)
 88     {
 89         bool checkUpLo = false;
 90         CBLAS_UPLO upLo = CblasUpper;
 91         if ((*_upLo=='L') || (*_upLo=='l')) {
 92             checkUpLo = true;
 93             upLo = CblasLower;
 94         }
 95         if ((*_upLo=='U') || (*_upLo=='u')) {
 96             checkUpLo = true;
 97         }
 98 
 99         CBLAS_INT n       = *_n;
100         CBLAS_INT incX    = *_incX;
101         CBLAS_INT incY    = *_incY;
102         CBLAS_INT ldA     = *_ldA;
103 
104 #   ifndef COMPLEX_FLOAT1
105         CBLAS_ALPHA alpha  = *_alpha;
106 #   else
107         CBLAS_ALPHA alpha = _alpha;
108 #   endif
109 
110         CBLAS_INT info = 0;
111         if (incY==0) {
112             info = 7;
113         }
114         if (incX==0) {
115             info = 5; 
116         }
117         if (ldA<std::max(1, n)) {
118             info = 9;
119         }
120         if (n<0) {
121             info = 2;
122         }
123         if (!checkUpLo) {
124             info = 1;
125         }
126         if (info!=0) {
127             char blasName[6];
128             strncpy(blasName, BLAS_NAME_STR, 6);
129             for (int i=0; i<6; ++i) {
130                 blasName[i] = std::toupper(blasName[i]);
131             }
132             xerbla_(blasName, &info);
133           return;
134         }
135 
136         // the blas interface calls the cblas interface
137         // so any blas-test will also test the cblas-interface
138         CBLAS_NAME(CblasColMajor, upLo,
139                    n,
140                    alpha,
141                    x, incX,
142                    y, incY,
143                    A, ldA);
144     }
145 #endif // CREATE_BLAS
146 
147 } // extern "C"
Home