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