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