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