1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#define STR(x) #x
#define STRING(x) STR(x)
#include <flens/lapack/interface/include/config.h>
namespace flens { namespace lapack {
extern "C" {
//-- dgejsv --------------------------------------------------------------------
void
LAPACK_DECL(dgejsv)(const char *JOBA,
const char *JOBU,
const char *JOBV,
const char *JOBR,
const char *JOBT,
const char *JOBP,
const INTEGER *M,
const INTEGER *N,
DOUBLE *A,
const INTEGER *LDA,
DOUBLE *SVA,
DOUBLE *U,
const INTEGER *LDU,
DOUBLE *V,
const INTEGER *LDV,
DOUBLE *WORK,
const INTEGER *LWORK,
INTEGER *IWORK,
INTEGER *INFO)
{
LAPACK_DEBUG_OUT("LAPACK INTERFACE: dgejsv");
//
// Test the input parameters so that we pass LAPACK error checks
//
const bool lsvec = (*JOBU=='U') || (*JOBU=='F');
const bool jracc = (*JOBV=='J');
const bool rsvec = (*JOBV=='V') || jracc;
const bool rowpiv = (*JOBA=='F') || (*JOBA=='G');
const bool l2rank = (*JOBA=='R');
const bool l2aber = (*JOBA=='A');
const bool errest = (*JOBA=='E') || (*JOBA=='G');
const bool l2tran = (*JOBT=='T');
const bool l2kill = (*JOBR=='R');
const bool defr = (*JOBR=='N');
const bool l2pert = (*JOBP=='P');
const int m = *M;
const int n = *N;
*INFO = 0;
if (!(rowpiv || l2rank || l2aber || errest || *JOBA=='C')) {
*INFO = -1;
} else if (!(lsvec || *JOBU=='N' || *JOBU=='W')) {
*INFO = -2;
} else if (!(rsvec || *JOBV=='N' || *JOBV=='W') || (jracc && !lsvec)) {
*INFO = -3;
} else if (!(l2kill || defr)) {
*INFO = -4;
} else if (!(l2tran || *JOBT=='N')) {
*INFO = -5;
} else if (!(l2pert || *JOBP=='N')) {
*INFO = -6;
} else if (m<0) {
*INFO = -7;
} else if ((n<0) || (n>m)) {
*INFO = -8;
} else if (*LDA<m) {
*INFO = -10;
} else if (lsvec && *LDU<m) {
*INFO = -13;
} else if (rsvec && *LDV<n) {
*INFO = -14;
} else if ((!(lsvec || rsvec || errest) || (*LWORK < max(7,4*n+1,2*m+n)))
|| (!(lsvec || rsvec) || errest || (*LWORK < max(7,4*n+n*n,2*m+n)))
|| (lsvec || (!rsvec) || (*LWORK < max(7,2*m+n,4*n+1)))
|| (rsvec || (!lsvec) || (*LWORK < max(7,2*m+n,4*n+1)))
|| (lsvec || rsvec || (!jracc) || (*LWORK<max(2*m+n,6*n+2*n*n)))
|| (lsvec || rsvec || jracc || *LWORK<max(2*m+n,4*n+n*n,2*n+n*n+6)))
{
*INFO = -17;
}
if (*INFO!=0) {
*INFO = -(*INFO);
LAPACK_ERROR("DGEJSV", INFO);
*INFO = -(*INFO);
return;
}
//
// Call FLENS implementation
//
JSV::Accuracy accuracy = JSV::Accuracy(*JOBA);
JSV::JobU jobU = JSV::JobU(*JOBU);
JSV::JobV jobV = JSV::JobV(*JOBV);
const bool restrictedRange = (*JOBR=='R');
const bool considerTransA = (*JOBT=='T');
const bool perturb = (*JOBR=='P');
DGeMatrixView _A = DFSView(m, n, *LDA, A);
DDenseVectorView _sva = DArrayView(n, SVA, INTEGER(1));
DGeMatrixView _U = DFSView(m, n, *LDU, U);
DGeMatrixView _V = DFSView(n, n, *LDV, V);
DDenseVectorView _work = DArrayView(*LWORK, WORK, INTEGER(1));
IDenseVectorView _iwork = IArrayView(m+3*n, IWORK, INTEGER(1));
*INFO = jsv(accuracy, jobU, jobV,
restrictedRange, considerTransA, perturb,
_A, _sva, _U, _V, _work, _iwork);
if (*INFO<0) {
*INFO = -(*INFO);
LAPACK_ERROR("DGEJSV", INFO);
*INFO = -(*INFO);
return;
}
}
} // extern "C"
} } // namespace lapack, flens
|