Home
Browse Files
  1 #include <flens/lapack/interface/include/config.h>
  2 
  3 
  4 namespace flens { namespace lapack {
  5 
  6 template <typename T>
  7 struct SelectFunction
  8 {
  9     typedef LOGICAL (* Function)(const T *, const T *);
 10 
 11     SelectFunction(Function _select)
 12         : select(_select)
 13     {
 14     }
 15 
 16     bool
 17     operator()(const T &a, const T &b)
 18     {
 19         return select(&a, &b);
 20     }
 21 
 22     Function  select;
 23 };
 24 
 25 
 26 extern "C" {
 27 
 28 //-- dgees ---------------------------------------------------------------------
 29 void
 30 LAPACK_DECL(dgees)(const char       *JOBVS,
 31                    const char       *SORT,
 32                    LOGICAL          (*SELECT)(const DOUBLE *, const DOUBLE *),
 33                    const INTEGER    *N,
 34                    DOUBLE           *A,
 35                    const INTEGER    *LDA,
 36                    INTEGER          *SDIM,
 37                    DOUBLE           *WR,
 38                    DOUBLE           *WI,
 39                    DOUBLE           *VS,
 40                    const INTEGER    *LDVS,
 41                    DOUBLE           *WORK,
 42                    const INTEGER    *LWORK,
 43                    LOGICAL          *BWORK,
 44                    INTEGER          *INFO)
 45 {
 46     DEBUG_FLENS_LAPACK("dgees");
 47 
 48     using std::max;
 49     using std::min;
 50 //
 51 //  Test the input parameters so that we pass LAPACK error checks
 52 //
 53     *INFO = 0;
 54     bool lQuery = (*LWORK==-1);
 55     bool wantVS = (*JOBVS=='V');
 56     bool wantST = (*SORT=='S');
 57 
 58     if ((!wantVS) && (*JOBVS!='N')) {
 59         *INFO = 1;
 60     } else if ((!wantST) && (*SORT!='N')) {
 61         *INFO = 2;
 62     } else if (*N<0) {
 63         *INFO = 4;
 64     } else if (*LDA<max(INTEGER(1),*N)) {
 65         *INFO = 6;
 66     } else if (*LDVS<1 || (wantVS && *LDVS<*N)) {
 67         *INFO = 11;
 68     }
 69 
 70     if (*INFO!=0) {
 71         LAPACK_ERROR("DGEES", INFO);
 72         *INFO = -(*INFO);
 73         return;
 74     }
 75 
 76 //
 77 //  Setup FLENS matrix/vector types
 78 //
 79     typedef DGeMatrixView::IndexType IndexType;
 80 
 81     DGeMatrixView       _A      = DFSView(*N, *N, A, *LDA);
 82     IndexType           _SDIM   = *SDIM;
 83     DDenseVectorView    _WR     = DArrayView(*N, WR, 1);
 84     DDenseVectorView    _WI     = DArrayView(*N, WI, 1);
 85     DGeMatrixView       _VS     = DFSView(*N, *N, VS, *LDVS);
 86     DDenseVectorView    _WORK   = DArrayView(*LWORK, WORK, 1);
 87 
 88     BDenseVector        _BWORK(*N);
 89     for (INTEGER i=1; i<*N; ++i) {
 90         _BWORK(i) = BWORK[i-1];
 91     }
 92 
 93 //
 94 //  Test if work has at least minimal worksize
 95 //
 96     auto ws = es_wsq(wantVS, _A);
 97 
 98     if (*LWORK<ws.first && !lQuery) {
 99         *INFO = 13;
100     }
101 
102     if (*INFO!=0) {
103         LAPACK_ERROR("DGEES", INFO);
104         *INFO = -(*INFO);
105         return;
106     }
107 //
108 //  Call FLENS implementation
109 //
110     SelectFunction<DOUBLE> select(SELECT);
111 
112     es(wantVS, wantST, select, _A, _SDIM, _WR, _WI, _VS, _WORK, _BWORK);
113 
114     *SDIM = _SDIM;
115     for (INTEGER i=1; i<*N; ++i) {
116         BWORK[i-1] = _BWORK(i);
117     }
118 }
119 
120 } // extern "C"
121 
122 } } // namespace lapack, flens
Home