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