Home
Browse Files
  1 #include <flens/lapack/interface/include/config.h>
  2 
  3 
  4 namespace flens { namespace lapack {
  5 
  6 extern "C" {
  7 
  8 //-- dgeevx --------------------------------------------------------------------
  9 void
 10 LAPACK_DECL(dgeevx)(const char       *BALANC,
 11                     const char       *JOBVL,
 12                     const char       *JOBVR,
 13                     const char       *_SENSE,
 14                     const INTEGER    *N,
 15                     DOUBLE           *A,
 16                     const INTEGER    *LDA,
 17                     DOUBLE           *WR,
 18                     DOUBLE           *WI,
 19                     DOUBLE           *VL,
 20                     const INTEGER    *LDVL,
 21                     DOUBLE           *VR,
 22                     const INTEGER    *LDVR,
 23                     INTEGER          *ILO,
 24                     INTEGER          *IHI,
 25                     DOUBLE           *SCALE,
 26                     DOUBLE           *ABNRM,
 27                     DOUBLE           *RCONDE,
 28                     DOUBLE           *RCONDV,
 29                     DOUBLE           *WORK,
 30                     const INTEGER    *LWORK,
 31                     INTEGER          *IWORK,
 32                     INTEGER          *INFO)
 33 {
 34     DEBUG_FLENS_LAPACK("dgeevx");
 35 
 36     using std::max;
 37     using std::min;
 38 //
 39 //  Test the input parameters so that we pass LAPACK error checks
 40 //
 41     *INFO = 0;
 42     const bool lQuery = (*LWORK==-1);
 43     const bool wantVL = (*JOBVL=='V');
 44     const bool wantVR = (*JOBVR=='V');
 45     const bool wantSNN = (*_SENSE=='N');
 46     const bool wantSNE = (*_SENSE=='E');
 47     const bool wantSNV = (*_SENSE=='V');
 48     const bool wantSNB = (*_SENSE=='B');
 49 
 50     if (*BALANC!='N' && *BALANC!='S' && *BALANC!='P' && *BALANC!='B') {
 51         *INFO = 1;
 52     } else if ((!wantVL) && (*JOBVL!='N')) {
 53         *INFO = 2;
 54     } else if ((!wantVR) && (*JOBVR!='N')) {
 55         *INFO = 3;
 56     } else if (!(wantSNN || wantSNE || wantSNB || wantSNV)
 57             || ((wantSNE || wantSNB ) && !(wantVL && wantVR)))
 58     {
 59         *INFO = 4;
 60     } else if (*N<0) {
 61         *INFO = 5;
 62     } else if (*LDA<max(INTEGER(1),*N)) {
 63         *INFO = 7;
 64     } else if (*LDVL<1 || (wantVL && *LDVL<*N)) {
 65         *INFO = 11;
 66     } else if (*LDVR<1 || (wantVR && *LDVR<*N)) {
 67         *INFO = 13;
 68     }
 69 
 70     if (*INFO!=0) {
 71         LAPACK_ERROR("DGEEVX", INFO);
 72         *INFO = -(*INFO);
 73         return;
 74     }
 75 
 76 //
 77 //  Setup FLENS matrix/vector types
 78 //
 79     BALANCE::Balance  balance = BALANCE::Balance(*BALANC);
 80     SENSE::Sense      sense   = SENSE::Sense(*_SENSE);
 81 
 82     ASSERT(char(balance)==*BALANC);
 83     ASSERT(char(sense)==*_SENSE);
 84 
 85     typedef typename DGeMatrixView::IndexType   IndexType;
 86 
 87     DGeMatrixView       _A      = DFSView(*N, *N, A, *LDA);
 88     DDenseVectorView    _WR     = DArrayView(*N, WR, 1);
 89     DDenseVectorView    _WI     = DArrayView(*N, WI, 1);
 90     DGeMatrixView       _VL     = DFSView(*N, *N, VL, *LDVL);
 91     DGeMatrixView       _VR     = DFSView(*N, *N, VR, *LDVR);
 92     IndexType           _ILO    = *ILO;
 93     IndexType           _IHI    = *IHI;
 94     DDenseVectorView    _SCALE  = DArrayView(*N, SCALE, 1);
 95     DDenseVectorView    _RCONDE = DArrayView(*N, RCONDE, 1);
 96     DDenseVectorView    _RCONDV = DArrayView(*N, RCONDV, 1);
 97     DDenseVectorView    _WORK   = DArrayView(*LWORK, WORK, 1);
 98 
 99     IDenseVector        _IWORK(*N * 2 - 2);
100     for (int i=1; i<=_IWORK.length(); ++i) {
101         _IWORK(i) = IWORK[i-1];
102     }
103 
104 //
105 //  Test if work has at least minimal worksize
106 //
107     auto ws = evx_wsq(wantVL, wantVR, sense, _A);
108 
109     if (*LWORK<ws.first && !lQuery) {
110         *INFO = 21;
111     }
112 
113     if (*INFO!=0) {
114         LAPACK_ERROR("DGEEVX", INFO);
115         *INFO = -(*INFO);
116         return;
117     }
118 //
119 //  Call FLENS implementation
120 //
121 
122     evx(balance, wantVL, wantVR, sense, _A, _WR, _WI, _VL, _VR, _ILO, _IHI,
123         _SCALE, *ABNRM, _RCONDE, _RCONDV, _WORK, _IWORK);
124 
125     for (int i=1; i<=_IWORK.length(); ++i) {
126         IWORK[i-1] = _IWORK(i);
127     }
128 
129     *ILO = _ILO;
130     *IHI = _IHI;
131 }
132 
133 } // extern "C"
134 
135 } } // namespace lapack, flens
Home