Home
Browse Files
  1 //#define CXXBLAS_DEBUG_OUT(x)      std::cerr << x << std::endl;
  2 
  3 #define STR(x)      #x
  4 #define STRING(x)   STR(x)
  5 
  6 #define FLENS_DEFAULT_INDEXTYPE int
  7 
  8 #include <flens/lapack/interface/include/config.h>
  9 
 10 
 11 namespace flens { namespace lapack {
 12 
 13 extern "C" {
 14 
 15 //-- dgetrs --------------------------------------------------------------------
 16 void
 17 LAPACK_DECL(dgesvj)(const char       *JOBA,
 18                     const char       *JOBU,
 19                     const char       *JOBV,
 20                     const INTEGER    *M,
 21                     const INTEGER    *N,
 22                     DOUBLE           *A,
 23                     const INTEGER    *LDA,
 24                     DOUBLE           *SVA,
 25                     const INTEGER    *MV,
 26                     DOUBLE           *V,
 27                     const INTEGER    *LDV,
 28                     DOUBLE           *WORK,
 29                     const INTEGER    *LWORK,
 30                     INTEGER          *INFO)
 31 {
 32     DEBUG_FLENS_LAPACK("dgesvj");
 33 //
 34 //  Test the input parameters so that we pass LAPACK error checks
 35 //
 36     const bool lsvec = (*JOBU=='U');
 37     const bool uctol = (*JOBU=='C');
 38     const bool rsvec = (*JOBV=='V');
 39     const bool applv = (*JOBV=='A');
 40     const bool upper = (*JOBA=='U');
 41     const bool lower = (*JOBA=='L');
 42 
 43     *INFO = 0;
 44     if (!(upper || lower || *JOBA=='G')) {
 45         *INFO = -1;
 46     } else if (!(lsvec || uctol || *JOBU=='N')) {
 47         *INFO = -2;
 48     } else if (!(rsvec || applv || *JOBV=='N')) {
 49         *INFO = -3;
 50     } else if (*M<0) {
 51         *INFO = -4;
 52     } else if ((*N<0) || (*N>*M)) {
 53         *INFO = -5;
 54     } else if (*LDA<std::max(INTEGER(1), *M)) {
 55         *INFO = -7;
 56     } else if (*MV<INTEGER(0)) {
 57         *INFO = -9;
 58     } else if ((rsvec && *LDV<*N) || (applv && *LDV<*MV)) {
 59         *INFO = -11;
 60     } else if (uctol && (*WORK<=DOUBLE(1))) {
 61         *INFO = -12;
 62     } else if (*LWORK<std::max(*M+*N,INTEGER(6))) {
 63         *INFO = -13;
 64     }
 65 
 66     if (*INFO!=0) {
 67         *INFO = -(*INFO);
 68         LAPACK_ERROR("DGESVJ", INFO);
 69         *INFO = -(*INFO);
 70         return;
 71     }
 72 
 73 //
 74 //  Call FLENS implementation
 75 //
 76     INTEGER mv = 0;
 77 
 78     if (*JOBV=='A') {
 79         mv = *MV;
 80     }
 81     if (*JOBV=='V') {
 82         mv = *N;
 83     }
 84 
 85     SVJ::TypeA        typeA  = SVJ::TypeA(*JOBA);
 86     SVJ::JobU         jobU   = SVJ::JobU(*JOBU);
 87     SVJ::JobV         jobV   = SVJ::JobV(*JOBV);
 88     DGeMatrixView     _A     = DFSView(*M, *N, A, *LDA);
 89     DDenseVectorView  _sva   = DArrayView(*N, SVA, INTEGER(1));
 90     DGeMatrixView     _V     = DFSView(mv, *N, V, *LDV);
 91     DDenseVectorView  _work  = DArrayView(*LWORK, WORK, INTEGER(1));
 92 
 93     *INFO = svj(typeA, jobU, jobV, _A, _sva, _V, _work);
 94 
 95     if (*INFO<0) {
 96         *INFO = -(*INFO);
 97         LAPACK_ERROR("DGESVJ", INFO);
 98         *INFO = -(*INFO);
 99         return;
100     }
101 }
102 
103 } // extern "C"
104 
105 } } // namespace lapack, flens
Home