Home
Browse Files
 1 #include <flens/lapack/interface/include/config.h>
 2 
 3 
 4 namespace flens { namespace lapack {
 5 
 6 extern "C" {
 7 
 8 //-- dormqr --------------------------------------------------------------------
 9 void
10 LAPACK_DECL(dormqr)(const char       *SIDE,
11                     const char       *TRANS,
12                     const INTEGER    *M,
13                     const INTEGER    *N,
14                     const INTEGER    *K,
15                     DOUBLE           *A,
16                     const INTEGER    *LDA,
17                     const DOUBLE     *TAU,
18                     DOUBLE           *C,
19                     const INTEGER    *LDC,
20                     DOUBLE           *WORK,
21                     const INTEGER    *LWORK,
22                     INTEGER          *INFO)
23 {
24     DEBUG_FLENS_LAPACK("dormqr");
25 
26     using std::max;
27     using std::min;
28 //
29 //  Test the input parameters so that we pass LAPACK error checks
30 //
31     *INFO = 0;
32     const bool left   = (*SIDE=='L');
33     const bool noTran = (*TRANS=='N');
34     const bool lQuery = (*LWORK==-1);
35 
36     INTEGER nq, nw;
37 
38     if (left) {
39         nq = *M;
40         nw = *N;
41     } else {
42         nq = *N;
43         nw = *M;
44     }
45     if (!left && *SIDE!='R') {
46         *INFO = -1;
47     } else if (!noTran && *TRANS!='T') {
48         *INFO = -2;
49     } else if (*M<0) {
50         *INFO = -3;
51     } else if (*N<0) {
52         *INFO = -4;
53     } else if (*K<0 || *K>nq) {
54         *INFO = -5;
55     } else if (*LDA<max(INTEGER(1), nq)) {
56         *INFO = -7;
57     } else if (*LDC<max(INTEGER(1), *M)) {
58         *INFO = -10;
59     } else if ((*LWORK<max(INTEGER(1), nw)) && (!lQuery)) {
60         *INFO = -12;
61     }
62     if (*INFO!=0) {
63         *INFO = -(*INFO);
64         LAPACK_ERROR("DORMQR", INFO);
65         *INFO = -(*INFO);
66         return;
67     }
68 //
69 //  Handle worksize query
70 //
71     if (lQuery) {
72         // TODO: implement lqf_wsq
73         ASSERT(0);
74     }
75 //
76 //  Call FLENS implementation
77 //
78     Side      side  = (*SIDE=='L') ? Left : Right;
79     Transpose trans = (*TRANS=='N') ? NoTrans : Trans;
80     const INTEGER numRowsA = (side==Left) ? *M : *N;
81 
82     DGeMatrixView          _A      = DFSView(numRowsA, *K, A, *LDA);
83     DConstDenseVectorView  _TAU    = DConstArrayView(*K, TAU, 1);
84     DGeMatrixView          _C      = DFSView(*M, *N, C, *LDC);
85     DDenseVectorView       _WORK   = DArrayView(*LWORK, WORK, 1);
86 
87     ormqr(side, trans, _A, _TAU, _C, _WORK);
88 }
89 
90 } // extern "C"
91 
92 } } // namespace lapack, flens
Home