blob: 77b302b6b4bac1c063b77d982f81a1340f6f3d37 [file] [log] [blame]
Austin Schuh189376f2018-12-20 22:11:15 +11001// This file is part of Eigen, a lightweight C++ template library
2// for linear algebra.
3//
4// Copyright (C) 2014 Gael Guennebaud <gael.guennebaud@inria.fr>
5//
6// This Source Code Form is subject to the terms of the Mozilla
7// Public License v. 2.0. If a copy of the MPL was not distributed
8// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
9
10#include "lapack_common.h"
11#include <Eigen/SVD>
12
13// computes the singular values/vectors a general M-by-N matrix A using divide-and-conquer
14EIGEN_LAPACK_FUNC(gesdd,(char *jobz, int *m, int* n, Scalar* a, int *lda, RealScalar *s, Scalar *u, int *ldu, Scalar *vt, int *ldvt, Scalar* /*work*/, int* lwork,
15 EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int * /*iwork*/, int *info))
16{
17 // TODO exploit the work buffer
18 bool query_size = *lwork==-1;
19 int diag_size = (std::min)(*m,*n);
20
21 *info = 0;
22 if(*jobz!='A' && *jobz!='S' && *jobz!='O' && *jobz!='N') *info = -1;
23 else if(*m<0) *info = -2;
24 else if(*n<0) *info = -3;
25 else if(*lda<std::max(1,*m)) *info = -5;
26 else if(*lda<std::max(1,*m)) *info = -8;
27 else if(*ldu <1 || (*jobz=='A' && *ldu <*m)
28 || (*jobz=='O' && *m<*n && *ldu<*m)) *info = -8;
29 else if(*ldvt<1 || (*jobz=='A' && *ldvt<*n)
30 || (*jobz=='S' && *ldvt<diag_size)
31 || (*jobz=='O' && *m>=*n && *ldvt<*n)) *info = -10;
32
33 if(*info!=0)
34 {
35 int e = -*info;
36 return xerbla_(SCALAR_SUFFIX_UP"GESDD ", &e, 6);
37 }
38
39 if(query_size)
40 {
41 *lwork = 0;
42 return 0;
43 }
44
45 if(*n==0 || *m==0)
46 return 0;
47
48 PlainMatrixType mat(*m,*n);
49 mat = matrix(a,*m,*n,*lda);
50
51 int option = *jobz=='A' ? ComputeFullU|ComputeFullV
52 : *jobz=='S' ? ComputeThinU|ComputeThinV
53 : *jobz=='O' ? ComputeThinU|ComputeThinV
54 : 0;
55
56 BDCSVD<PlainMatrixType> svd(mat,option);
57
58 make_vector(s,diag_size) = svd.singularValues().head(diag_size);
59
60 if(*jobz=='A')
61 {
62 matrix(u,*m,*m,*ldu) = svd.matrixU();
63 matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
64 }
65 else if(*jobz=='S')
66 {
67 matrix(u,*m,diag_size,*ldu) = svd.matrixU();
68 matrix(vt,diag_size,*n,*ldvt) = svd.matrixV().adjoint();
69 }
70 else if(*jobz=='O' && *m>=*n)
71 {
72 matrix(a,*m,*n,*lda) = svd.matrixU();
73 matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
74 }
75 else if(*jobz=='O')
76 {
77 matrix(u,*m,*m,*ldu) = svd.matrixU();
78 matrix(a,diag_size,*n,*lda) = svd.matrixV().adjoint();
79 }
80
81 return 0;
82}
83
84// computes the singular values/vectors a general M-by-N matrix A using two sided jacobi algorithm
85EIGEN_LAPACK_FUNC(gesvd,(char *jobu, char *jobv, int *m, int* n, Scalar* a, int *lda, RealScalar *s, Scalar *u, int *ldu, Scalar *vt, int *ldvt, Scalar* /*work*/, int* lwork,
86 EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int *info))
87{
88 // TODO exploit the work buffer
89 bool query_size = *lwork==-1;
90 int diag_size = (std::min)(*m,*n);
91
92 *info = 0;
93 if( *jobu!='A' && *jobu!='S' && *jobu!='O' && *jobu!='N') *info = -1;
94 else if((*jobv!='A' && *jobv!='S' && *jobv!='O' && *jobv!='N')
95 || (*jobu=='O' && *jobv=='O')) *info = -2;
96 else if(*m<0) *info = -3;
97 else if(*n<0) *info = -4;
98 else if(*lda<std::max(1,*m)) *info = -6;
99 else if(*ldu <1 || ((*jobu=='A' || *jobu=='S') && *ldu<*m)) *info = -9;
100 else if(*ldvt<1 || (*jobv=='A' && *ldvt<*n)
101 || (*jobv=='S' && *ldvt<diag_size)) *info = -11;
102
103 if(*info!=0)
104 {
105 int e = -*info;
106 return xerbla_(SCALAR_SUFFIX_UP"GESVD ", &e, 6);
107 }
108
109 if(query_size)
110 {
111 *lwork = 0;
112 return 0;
113 }
114
115 if(*n==0 || *m==0)
116 return 0;
117
118 PlainMatrixType mat(*m,*n);
119 mat = matrix(a,*m,*n,*lda);
120
121 int option = (*jobu=='A' ? ComputeFullU : *jobu=='S' || *jobu=='O' ? ComputeThinU : 0)
122 | (*jobv=='A' ? ComputeFullV : *jobv=='S' || *jobv=='O' ? ComputeThinV : 0);
123
124 JacobiSVD<PlainMatrixType> svd(mat,option);
125
126 make_vector(s,diag_size) = svd.singularValues().head(diag_size);
127 {
128 if(*jobu=='A') matrix(u,*m,*m,*ldu) = svd.matrixU();
129 else if(*jobu=='S') matrix(u,*m,diag_size,*ldu) = svd.matrixU();
130 else if(*jobu=='O') matrix(a,*m,diag_size,*lda) = svd.matrixU();
131 }
132 {
133 if(*jobv=='A') matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
134 else if(*jobv=='S') matrix(vt,diag_size,*n,*ldvt) = svd.matrixV().adjoint();
135 else if(*jobv=='O') matrix(a,diag_size,*n,*lda) = svd.matrixV().adjoint();
136 }
137 return 0;
138}