Mercurial > octave-nkf
annotate liboctave/numeric/eigs-base.cc @ 18846:492c56149535 stable rc-3-8-2-1
3.8.2 release candidate 1
* configure.ac (OCTAVE_VERSION): Bump to 3.8.2-rc1.
(OCTAVE_MINOR_VERSION): Bump to 2-rc1.
(OCTAVE_RELEASE_DATE): Set to 2014-06-06.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Fri, 06 Jun 2014 11:43:17 -0400 |
parents | 49a5a4be04a1 |
children | 65554f5847ac |
rev | line source |
---|---|
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1 /* |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2 |
17744
d63878346099
maint: Update copyright notices for release.
John W. Eaton <jwe@octave.org>
parents:
15271
diff
changeset
|
3 Copyright (C) 2005-2013 David Bateman |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
4 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
5 This file is part of Octave. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
6 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
7 Octave is free software; you can redistribute it and/or modify it |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
8 under the terms of the GNU General Public License as published by the |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
9 Free Software Foundation; either version 3 of the License, or (at your |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
10 option) any later version. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
11 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
12 Octave is distributed in the hope that it will be useful, but WITHOUT |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
15 for more details. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
16 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
17 You should have received a copy of the GNU General Public License |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
18 along with Octave; see the file COPYING. If not, see |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
19 <http://www.gnu.org/licenses/>. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
20 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
21 */ |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
22 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
23 #ifdef HAVE_CONFIG_H |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
24 #include <config.h> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
25 #endif |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
26 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
27 #include <cfloat> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
28 #include <cmath> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
29 #include <vector> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
30 #include <iostream> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
31 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
32 #include "f77-fcn.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
33 #include "quit.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
34 #include "SparsedbleLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
35 #include "SparseCmplxLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
36 #include "dSparse.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
37 #include "CSparse.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
38 #include "MatrixType.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
39 #include "SparsedbleCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
40 #include "SparseCmplxCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
41 #include "oct-rand.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
42 #include "dbleCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
43 #include "CmplxCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
44 #include "dbleLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
45 #include "CmplxLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
46 |
14144
834df9f10963
remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
47 #ifdef HAVE_ARPACK |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
48 typedef ColumnVector (*EigsFunc) (const ColumnVector &x, int &eigs_error); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
49 typedef ComplexColumnVector (*EigsComplexFunc) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
50 (const ComplexColumnVector &x, int &eigs_error); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
51 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
52 // Arpack and blas fortran functions we call. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
53 extern "C" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
54 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
55 F77_RET_T |
11518 | 56 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&, |
57 F77_CONST_CHAR_ARG_DECL, | |
58 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
59 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
60 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
61 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
62 const octave_idx_type&, octave_idx_type*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
63 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
64 const octave_idx_type&, octave_idx_type& |
11518 | 65 F77_CHAR_ARG_LEN_DECL |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
66 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
67 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
68 F77_RET_T |
11518 | 69 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&, |
70 F77_CONST_CHAR_ARG_DECL, | |
71 octave_idx_type*, double*, double*, | |
72 const octave_idx_type&, const double&, | |
73 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
74 const octave_idx_type&, |
11518 | 75 F77_CONST_CHAR_ARG_DECL, |
76 const octave_idx_type&, const double&, double*, | |
77 const octave_idx_type&, double*, | |
78 const octave_idx_type&, octave_idx_type*, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
79 octave_idx_type*, double*, double*, |
11518 | 80 const octave_idx_type&, octave_idx_type& |
81 F77_CHAR_ARG_LEN_DECL | |
82 F77_CHAR_ARG_LEN_DECL | |
83 F77_CHAR_ARG_LEN_DECL); | |
84 | |
85 F77_RET_T | |
86 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&, | |
87 F77_CONST_CHAR_ARG_DECL, | |
88 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
89 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
90 octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
91 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
92 const octave_idx_type&, octave_idx_type*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
93 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
94 const octave_idx_type&, octave_idx_type& |
11518 | 95 F77_CHAR_ARG_LEN_DECL |
96 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
97 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
98 F77_RET_T |
11518 | 99 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&, |
100 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
101 octave_idx_type*, double*, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
102 double*, const octave_idx_type&, const double&, |
11518 | 103 const double&, double*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
104 F77_CONST_CHAR_ARG_DECL, |
11518 | 105 const octave_idx_type&, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
106 F77_CONST_CHAR_ARG_DECL, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
107 octave_idx_type&, const double&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
108 const octave_idx_type&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
109 const octave_idx_type&, octave_idx_type*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
110 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
111 const octave_idx_type&, octave_idx_type& |
11518 | 112 F77_CHAR_ARG_LEN_DECL |
113 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
114 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
115 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
116 F77_RET_T |
11518 | 117 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&, |
118 F77_CONST_CHAR_ARG_DECL, | |
119 const octave_idx_type&, | |
120 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
121 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
122 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
123 const octave_idx_type&, octave_idx_type*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
124 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
125 const octave_idx_type&, double *, octave_idx_type& |
11518 | 126 F77_CHAR_ARG_LEN_DECL |
127 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
128 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
129 F77_RET_T |
11518 | 130 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&, |
131 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
132 octave_idx_type*, Complex*, Complex*, |
11518 | 133 const octave_idx_type&, const Complex&, Complex*, |
134 F77_CONST_CHAR_ARG_DECL, | |
135 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
136 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
137 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
138 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
139 const octave_idx_type&, octave_idx_type*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
140 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
141 const octave_idx_type&, double *, octave_idx_type& |
11518 | 142 F77_CHAR_ARG_LEN_DECL |
143 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
144 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
145 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
146 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
147 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, |
11518 | 148 const octave_idx_type&, const octave_idx_type&, |
149 const double&, const double*, | |
150 const octave_idx_type&, const double*, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
151 const octave_idx_type&, const double&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
152 const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
153 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
154 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
155 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
156 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
157 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
158 const octave_idx_type&, const octave_idx_type&, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
159 const Complex&, const Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
160 const octave_idx_type&, const Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
161 const octave_idx_type&, const Complex&, Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
162 const octave_idx_type& |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
163 F77_CHAR_ARG_LEN_DECL); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
164 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
165 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
166 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
167 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
168 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
169 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
170 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
171 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
172 static octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
173 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
174 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
175 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
176 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
177 lusolve (const Matrix&, const Matrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
178 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
179 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
180 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
181 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
182 static ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
183 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
184 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
185 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
186 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
187 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
188 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
189 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
190 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
191 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
192 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
193 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
194 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
195 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
196 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
197 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
198 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
199 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
200 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
201 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
202 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
203 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
204 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
205 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
206 |
12202
dc72a664ac7a
eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents:
12198
diff
changeset
|
207 #endif |
dc72a664ac7a
eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents:
12198
diff
changeset
|
208 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
209 template <class M, class SM> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
210 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
211 lusolve (const SM& L, const SM& U, M& m) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
212 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
213 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
214 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
215 MatrixType utyp (MatrixType::Upper); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
216 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
217 // Sparse L is lower triangular, Dense L is permuted lower triangular!!! |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
218 m = L.solve (m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
219 if (err) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
220 return err; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
221 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
222 m = U.solve (utyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
223 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
224 return err; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
225 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
226 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
227 template <class SM, class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
228 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
229 ltsolve (const SM& L, const ColumnVector& Q, const M& m) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
230 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
231 octave_idx_type n = L.cols (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
232 octave_idx_type b_nc = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
233 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
234 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
235 MatrixType ltyp (MatrixType::Lower); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
236 M tmp = L.solve (ltyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
237 M retval; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
238 const double* qv = Q.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
239 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
240 if (!err) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
241 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
242 retval.resize (n, b_nc); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
243 for (octave_idx_type j = 0; j < b_nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
244 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
245 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
246 retval.elem (static_cast<octave_idx_type>(qv[i]), j) = |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
247 tmp.elem (i,j); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
248 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
249 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
250 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
251 return retval; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
252 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
253 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
254 template <class SM, class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
255 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
256 utsolve (const SM& U, const ColumnVector& Q, const M& m) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
257 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
258 octave_idx_type n = U.cols (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
259 octave_idx_type b_nc = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
260 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
261 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
262 MatrixType utyp (MatrixType::Upper); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
263 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
264 M retval (n, b_nc); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
265 const double* qv = Q.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
266 for (octave_idx_type j = 0; j < b_nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
267 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
268 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
269 retval.elem (i,j) = m.elem (static_cast<octave_idx_type>(qv[i]), j); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
270 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
271 return U.solve (utyp, retval, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
272 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
273 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
274 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
275 vector_product (const SparseMatrix& m, const double* x, double* y) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
276 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
277 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
278 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
279 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
280 y[j] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
281 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
282 for (octave_idx_type j = 0; j < nc; j++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
283 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
284 y[m.ridx (i)] += m.data (i) * x[j]; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
285 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
286 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
287 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
288 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
289 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
290 vector_product (const Matrix& m, const double *x, double *y) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
291 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
292 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
293 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
294 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
295 F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
296 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
297 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
298 F77_CHAR_ARG_LEN (1))); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
299 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
300 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
301 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
302 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
303 ("eigs: unrecoverable error in dgemv"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
304 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
305 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
306 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
307 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
308 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
309 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
310 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
311 vector_product (const SparseComplexMatrix& m, const Complex* x, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
312 Complex* y) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
313 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
314 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
315 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
316 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
317 y[j] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
318 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
319 for (octave_idx_type j = 0; j < nc; j++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
320 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
321 y[m.ridx (i)] += m.data (i) * x[j]; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
322 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
323 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
324 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
325 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
326 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
327 vector_product (const ComplexMatrix& m, const Complex *x, Complex *y) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
328 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
329 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
330 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
331 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
332 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
333 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
334 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
335 F77_CHAR_ARG_LEN (1))); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
336 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
337 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
338 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
339 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
340 ("eigs: unrecoverable error in zgemv"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
341 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
342 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
343 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
344 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
345 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
346 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
347 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
348 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
349 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
350 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
351 CHOL fact (b, info); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
352 octave_idx_type n = b.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
353 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
354 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
355 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
356 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
357 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
358 bt = fact.chol_matrix (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
359 b = bt.transpose (); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
360 permB = ColumnVector (n); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
361 for (octave_idx_type i = 0; i < n; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
362 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
363 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
364 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
365 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
366 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
367 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
368 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
369 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
370 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
371 SparseCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
372 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
373 if (fact.P () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
374 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
375 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
376 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
377 b = fact.L (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
378 bt = b.transpose (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
379 permB = fact.perm () - 1.0; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
380 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
381 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
382 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
383 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
384 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
385 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
386 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
387 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
388 ComplexCHOL fact (b, info); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
389 octave_idx_type n = b.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
390 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
391 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
392 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
393 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
394 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
395 bt = fact.chol_matrix (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
396 b = bt.hermitian (); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
397 permB = ColumnVector (n); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
398 for (octave_idx_type i = 0; i < n; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
399 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
400 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
401 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
402 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
403 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
404 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
405 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
406 ColumnVector& permB) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
407 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
408 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
409 SparseComplexCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
410 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
411 if (fact.P () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
412 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
413 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
414 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
415 b = fact.L (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
416 bt = b.hermitian (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
417 permB = fact.perm () - 1.0; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
418 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
419 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
420 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
421 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
422 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
423 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
424 bool cholB, const ColumnVector& permB, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
425 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
426 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
427 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
428 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
429 octave_idx_type n = m.rows (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
430 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
431 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
432 SparseMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
433 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
434 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
435 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
436 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
437 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
438 if (permB.length ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
439 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
440 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
441 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
442 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
443 tmp.xcidx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
444 tmp.xridx (i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
445 static_cast<octave_idx_type>(permB(i)); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
446 tmp.xdata (i) = 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
447 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
448 tmp.xcidx (n) = n; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
449 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
450 AminusSigmaB = AminusSigmaB - sigma * tmp * |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
451 b.transpose () * b * tmp.transpose (); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
452 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
453 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
454 AminusSigmaB = AminusSigmaB - sigma * |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
455 b.transpose () * b; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
456 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
457 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
458 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
459 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
460 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
461 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
462 SparseMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
463 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
464 // Create sigma * speye (n,n) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
465 sigmat.xcidx (0) = 0; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
466 for (octave_idx_type i = 0; i < n; i++) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
467 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
468 sigmat.xdata (i) = sigma; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
469 sigmat.xridx (i) = i; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
470 sigmat.xcidx (i+1) = i + 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
471 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
472 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
473 AminusSigmaB = AminusSigmaB - sigmat; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
474 } |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
475 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
476 SparseLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
477 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
478 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
479 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
480 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
481 const octave_idx_type *Q2 = fact.col_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
482 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
483 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
484 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
485 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
486 Q[j] = Q2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
487 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
488 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
489 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
490 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
491 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
492 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
493 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
494 double d = 0.; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
495 if (U.xcidx (j+1) > U.xcidx (j) && |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
496 U.xridx (U.xcidx (j+1)-1) == j) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
497 d = std::abs (U.xdata (U.xcidx (j+1)-1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
498 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
499 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
500 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
501 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
502 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
503 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
504 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
505 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
506 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
507 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
508 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
509 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
510 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
511 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
512 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
513 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
514 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
515 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
516 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
517 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
518 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
519 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
520 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
521 LuAminusSigmaB (const Matrix &m, const Matrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
522 bool cholB, const ColumnVector& permB, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
523 Matrix &L, Matrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
524 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
525 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
526 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
527 octave_idx_type n = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
528 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
529 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
530 Matrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
531 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
532 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
533 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
534 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
535 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
536 Matrix tmp = sigma * b.transpose () * b; |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
537 const double *pB = permB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
538 double *p = AminusSigmaB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
539 |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
540 if (permB.length ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
541 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
542 for (octave_idx_type j = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
543 j < b.cols (); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
544 for (octave_idx_type i = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
545 i < b.rows (); i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
546 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
547 static_cast<octave_idx_type>(pB[j])); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
548 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
549 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
550 AminusSigmaB = AminusSigmaB - tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
551 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
552 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
553 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
554 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
555 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
556 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
557 double *p = AminusSigmaB.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
558 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
559 for (octave_idx_type i = 0; i < n; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
560 p[i*(n+1)] -= sigma; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
561 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
562 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
563 LU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
564 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
565 L = fact.P ().transpose () * fact.L (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
566 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
567 for (octave_idx_type j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
568 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
569 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
570 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
571 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
572 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
573 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
574 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
575 double d = std::abs (U.xelem (j,j)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
576 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
577 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
578 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
579 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
580 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
581 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
582 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
583 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
584 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
585 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
586 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
587 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
588 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
589 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
590 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
591 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
592 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
593 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
594 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
595 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
596 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
597 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
598 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
599 bool cholB, const ColumnVector& permB, Complex sigma, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
600 SparseComplexMatrix &L, SparseComplexMatrix &U, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
601 octave_idx_type *P, octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
602 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
603 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
604 octave_idx_type n = m.rows (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
605 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
606 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
607 SparseComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
608 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
609 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
610 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
611 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
612 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
613 if (permB.length ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
614 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
615 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
616 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
617 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
618 tmp.xcidx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
619 tmp.xridx (i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
620 static_cast<octave_idx_type>(permB(i)); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
621 tmp.xdata (i) = 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
622 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
623 tmp.xcidx (n) = n; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
624 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
625 AminusSigmaB = AminusSigmaB - tmp * b.hermitian () * b * |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
626 tmp.transpose () * sigma; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
627 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
628 else |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
629 AminusSigmaB = AminusSigmaB - sigma * b.hermitian () * b; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
630 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
631 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
632 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
633 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
634 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
635 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
636 SparseComplexMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
637 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
638 // Create sigma * speye (n,n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
639 sigmat.xcidx (0) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
640 for (octave_idx_type i = 0; i < n; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
641 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
642 sigmat.xdata (i) = sigma; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
643 sigmat.xridx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
644 sigmat.xcidx (i+1) = i + 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
645 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
646 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
647 AminusSigmaB = AminusSigmaB - sigmat; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
648 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
649 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
650 SparseComplexLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
651 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
652 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
653 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
654 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
655 const octave_idx_type *Q2 = fact.col_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
656 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
657 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
658 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
659 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
660 Q[j] = Q2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
661 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
662 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
663 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
664 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
665 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
666 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
667 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
668 double d = 0.; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
669 if (U.xcidx (j+1) > U.xcidx (j) && |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
670 U.xridx (U.xcidx (j+1)-1) == j) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
671 d = std::abs (U.xdata (U.xcidx (j+1)-1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
672 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
673 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
674 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
675 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
676 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
677 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
678 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
679 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
680 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
681 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
682 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
683 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
684 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
685 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
686 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
687 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
688 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
689 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
690 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
691 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
692 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
693 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
694 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
695 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
696 bool cholB, const ColumnVector& permB, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
697 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
698 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
699 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
700 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
701 octave_idx_type n = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
702 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
703 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
704 ComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
705 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
706 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
707 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
708 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
709 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
710 ComplexMatrix tmp = sigma * b.hermitian () * b; |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
711 const double *pB = permB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
712 Complex *p = AminusSigmaB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
713 |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
714 if (permB.length ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
715 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
716 for (octave_idx_type j = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
717 j < b.cols (); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
718 for (octave_idx_type i = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
719 i < b.rows (); i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
720 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
721 static_cast<octave_idx_type>(pB[j])); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
722 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
723 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
724 AminusSigmaB = AminusSigmaB - tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
725 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
726 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
727 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
728 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
729 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
730 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
731 Complex *p = AminusSigmaB.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
732 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
733 for (octave_idx_type i = 0; i < n; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
734 p[i*(n+1)] -= sigma; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
735 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
736 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
737 ComplexLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
738 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
739 L = fact.P ().transpose () * fact.L (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
740 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
741 for (octave_idx_type j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
742 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
743 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
744 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
745 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
746 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
747 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
748 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
749 double d = std::abs (U.xelem (j,j)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
750 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
751 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
752 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
753 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
754 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
755 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
756 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
757 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
758 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
759 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
760 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
761 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
762 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
763 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
764 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
765 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
766 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
767 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
768 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
769 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
770 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
771 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
772 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
773 EigsRealSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
774 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
775 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
776 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
777 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
778 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
779 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
780 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
781 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
782 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
783 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
784 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
785 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
786 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
787 double sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
788 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
789 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
790 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
791 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
792 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
793 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
794 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
795 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
796 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
797 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
798 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
799 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
800 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
801 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
802 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
803 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
804 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
805 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
806 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
807 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
808 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
809 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
810 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
811 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
812 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
813 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
814 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
815 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
816 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
817 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
818 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
819 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
820 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
821 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
822 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
823 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
824 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
825 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
826 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
827 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
828 if (k < 1 || k > n - 2) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
829 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
830 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
831 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
832 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
833 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
834 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
835 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
836 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
837 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
838 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
839 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
840 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
841 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
842 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
843 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
844 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
845 // Check the we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
846 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
847 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
848 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
849 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
850 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
851 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
852 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
853 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
854 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
855 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
856 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
857 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
858 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
859 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
860 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
861 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
862 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
863 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
864 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
865 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
866 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
867 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
868 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
869 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
870 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
871 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
872 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
873 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
874 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
875 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
876 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
877 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
878 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
879 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
880 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
881 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
882 ("eigs: invalid sigma value for real symmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
883 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
884 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
885 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
886 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
887 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
888 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
889 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
890 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
891 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
892 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
893 b = b.transpose (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
894 if (permB.length () == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
895 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
896 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
897 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
898 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
899 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
900 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
901 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
902 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
903 if (! make_cholb (b, bt, permB)) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
904 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
905 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
906 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
907 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
908 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
909 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
910 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
911 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
912 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
913 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
914 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
915 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
916 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
917 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
918 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
919 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
920 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
921 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
922 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
923 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
924 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
925 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
926 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
927 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
928 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
929 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
930 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
931 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
932 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
933 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
934 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
935 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
936 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
937 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
938 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
939 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
940 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
941 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
942 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
943 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
944 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
945 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
946 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
947 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
948 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
949 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
950 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
951 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
952 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
953 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
954 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
955 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
956 if (disp > 0 && !xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
957 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
958 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
959 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
960 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
961 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
962 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
963 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
964 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
965 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
966 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
967 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
968 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
969 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
970 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
971 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
972 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
973 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
974 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
975 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
976 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
977 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
978 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
979 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
980 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
981 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
982 mtmp(i,0) = workd[i + iptr(0) - 1]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
983 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
984 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
985 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
986 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
987 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
988 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
989 else if (!vector_product (m, workd + iptr(0) - 1, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
990 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
991 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
992 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
993 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
994 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
995 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
996 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
997 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
998 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
999 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1000 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1001 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1002 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1003 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1004 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1005 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1006 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1007 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1008 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1009 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1010 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1011 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1012 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1013 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1014 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1015 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
1016 octave_idx_type *sel = s.fortran_vec (); |
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
1017 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1018 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1019 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1020 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1021 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1022 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1023 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1024 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1025 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1026 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1027 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1028 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1029 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1030 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1031 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1032 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1033 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1034 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1035 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1036 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1037 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1038 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1039 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1040 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1041 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1042 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1043 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1044 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1045 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1046 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1047 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1048 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1049 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1050 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1051 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1052 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1053 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1054 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1055 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1056 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1057 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1058 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1059 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1060 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1061 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1062 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1063 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1064 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1065 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1066 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1067 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1068 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1069 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1070 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1071 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1072 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1073 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1074 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1075 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1076 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1077 if (note3) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1078 eig_vec = ltsolve (b, permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1079 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1080 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1081 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1082 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1083 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1084 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1085 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1086 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1087 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1088 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1089 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1090 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1091 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1092 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1093 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1094 EigsRealSymmetricMatrixShift (const M& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1095 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1096 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1097 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1098 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1099 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1100 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1101 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1102 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1103 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1104 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1105 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1106 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1107 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1108 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1109 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1110 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1111 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1112 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1113 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1114 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1115 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1116 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1117 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1118 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1119 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1120 // FIXME: The "SM" type for mode 1 seems unstable though faster!! |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1121 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1122 // return EigsRealSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1123 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1124 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1125 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1126 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1127 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1128 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1129 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1130 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1131 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1132 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1133 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1134 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1135 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1136 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1137 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1138 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1139 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1140 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1141 if (k <= 0 || k >= n - 1) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1142 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1143 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1144 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1145 " Use 'eig (full (A))' instead"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1146 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1147 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1148 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1149 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1150 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1151 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1152 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1153 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1154 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1155 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1156 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1157 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1158 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1159 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1160 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1161 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1162 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1163 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1164 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1165 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1166 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1167 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1168 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1169 // Check the we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1170 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1171 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1172 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1173 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1174 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1175 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1176 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1177 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1178 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1179 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1180 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1181 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1182 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1183 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1184 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1185 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1186 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1187 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1188 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1189 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1190 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1191 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1192 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1193 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1194 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1195 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1196 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1197 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1198 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1199 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1200 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1201 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1202 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1203 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1204 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1205 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1206 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1207 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1208 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1209 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1210 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1211 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1212 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1213 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1214 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1215 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1216 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1217 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1218 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1219 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1220 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1221 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1222 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1223 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1224 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1225 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1226 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1227 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1228 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1229 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1230 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1231 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1232 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1233 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1234 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1235 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1236 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1237 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1238 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1239 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1240 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1241 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1242 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1243 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1244 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1245 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1246 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1247 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1248 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1249 if (disp > 0 && !xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1250 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1251 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1252 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1253 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1254 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1255 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1256 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1257 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1258 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1259 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1260 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1261 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1262 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1263 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1264 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1265 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1266 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1267 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1268 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1269 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1270 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1271 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1272 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1273 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1274 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1275 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1276 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1277 vector_product (m, workd+iptr(0)-1, dtmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1278 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1279 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1280 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1281 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1282 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1283 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1284 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1285 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1286 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1287 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1288 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1289 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1290 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1291 vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1292 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1293 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1294 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1295 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1296 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1297 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1298 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1299 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1300 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1301 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1302 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1303 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1304 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1305 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1306 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1307 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1308 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1309 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1310 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1311 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1312 workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1313 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1314 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1315 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1316 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1317 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1318 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1319 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1320 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1321 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1322 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1323 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1324 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1325 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1326 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1327 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1328 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1329 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1330 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1331 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1332 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1333 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1334 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1335 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1336 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1337 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1338 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1339 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1340 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1341 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1342 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1343 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1344 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1345 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1346 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1347 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1348 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1349 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1350 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1351 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1352 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
1353 octave_idx_type *sel = s.fortran_vec (); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1354 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1355 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1356 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1357 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1358 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1359 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1360 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1361 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1362 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1363 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1364 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1365 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, info2 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1366 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1367 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1368 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1369 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1370 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1371 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1372 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1373 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1374 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1375 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1376 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1377 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1378 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1379 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1380 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1381 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1382 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1383 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1384 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1385 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1386 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1387 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1388 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1389 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1390 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1391 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1392 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1393 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1394 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1395 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1396 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1397 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1398 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1399 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1400 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1401 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1402 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1403 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1404 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1405 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1406 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1407 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1408 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1409 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1410 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1411 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1412 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1413 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1414 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1415 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1416 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1417 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1418 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1419 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1420 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1421 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1422 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1423 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1424 octave_idx_type &info, Matrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1425 ColumnVector &eig_val, ColumnVector &resid, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
1426 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1427 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1428 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1429 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1430 bool have_sigma = (sigma ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1431 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1432 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1433 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1434 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1435 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1436 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1437 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1438 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1439 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1440 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1441 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1442 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1443 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1444 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1445 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1446 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1447 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1448 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1449 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1450 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1451 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1452 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1453 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1454 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1455 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1456 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1457 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1458 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1459 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1460 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1461 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1462 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1463 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1464 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1465 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1466 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1467 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1468 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1469 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1470 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1471 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1472 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1473 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1474 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1475 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1476 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1477 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1478 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1479 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1480 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1481 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1482 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1483 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1484 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1485 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1486 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1487 ("eigs: invalid sigma value for real symmetric problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1488 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1489 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1490 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1491 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1492 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1493 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1494 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1495 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1496 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1497 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1498 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1499 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1500 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1501 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1502 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1503 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1504 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1505 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1506 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1507 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1508 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1509 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1510 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1511 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1512 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1513 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1514 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1515 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1516 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1517 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1518 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1519 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1520 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1521 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1522 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1523 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1524 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1525 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1526 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1527 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1528 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1529 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1530 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1531 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1532 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1533 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1534 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1535 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1536 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1537 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1538 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1539 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1540 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1541 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1542 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1543 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1544 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1545 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1546 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1547 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1548 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1549 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1550 if (disp > 0 && !xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1551 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1552 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1553 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1554 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1555 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1556 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1557 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1558 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1559 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1560 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1561 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1562 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1563 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1564 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1565 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1566 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1567 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1568 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1569 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1570 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1571 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1572 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1573 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1574 ColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1575 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1576 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1577 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1578 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1579 ColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1580 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1581 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1582 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1583 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1584 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1585 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1586 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1587 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1588 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1589 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1590 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1591 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1592 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1593 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1594 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1595 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1596 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1597 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1598 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1599 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1600 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1601 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1602 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1603 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1604 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1605 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1606 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1607 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1608 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1609 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1610 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
1611 octave_idx_type *sel = s.fortran_vec (); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1612 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1613 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1614 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1615 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1616 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1617 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1618 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1619 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1620 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1621 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1622 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1623 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, info2 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1624 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1625 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1626 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1627 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1628 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1629 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1630 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1631 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1632 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1633 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1634 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1635 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1636 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1637 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1638 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1639 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1640 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1641 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1642 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1643 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1644 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1645 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1646 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1647 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1648 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1649 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1650 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1651 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1652 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1653 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1654 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1655 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1656 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1657 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1658 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1659 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1660 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1661 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1662 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1663 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1664 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1665 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1666 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1667 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1668 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1669 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1670 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1671 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1672 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1673 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1674 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1675 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1676 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1677 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1678 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1679 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1680 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1681 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1682 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1683 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1684 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1685 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1686 EigsRealNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1687 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1688 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1689 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1690 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1691 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1692 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1693 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1694 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1695 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1696 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1697 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1698 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1699 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1700 double sigmar = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1701 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1702 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1703 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1704 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1705 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1706 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1707 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1708 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1709 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1710 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1711 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1712 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1713 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1714 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1715 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1716 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1717 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1718 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1719 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1720 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1721 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1722 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1723 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1724 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1725 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1726 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1727 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1728 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1729 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1730 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1731 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1732 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1733 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1734 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1735 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1736 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1737 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1738 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1739 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1740 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1741 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1742 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1743 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1744 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1745 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1746 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1747 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1748 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1749 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1750 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1751 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1752 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1753 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1754 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1755 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1756 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1757 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1758 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1759 // Check the we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1760 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1761 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1762 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1763 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1764 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1765 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1766 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1767 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1768 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1769 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1770 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1771 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1772 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1773 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1774 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1775 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1776 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1777 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1778 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1779 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1780 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1781 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1782 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1783 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1784 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1785 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1786 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1787 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1788 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1789 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1790 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1791 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1792 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1793 if (typ == "LA" || typ == "SA" || typ == "BE") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1794 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1795 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1796 ("eigs: invalid sigma value for unsymmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1797 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1798 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1799 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1800 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1801 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1802 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1803 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1804 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1805 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1806 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1807 b = b.transpose (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1808 if (permB.length () == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1809 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1810 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1811 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1812 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1813 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1814 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1815 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1816 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1817 if (! make_cholb (b, bt, permB)) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1818 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1819 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1820 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1821 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1822 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1823 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1824 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1825 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1826 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1827 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1828 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1829 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1830 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1831 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1832 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1833 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1834 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1835 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1836 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1837 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1838 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1839 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1840 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1841 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1842 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1843 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1844 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1845 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1846 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1847 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1848 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1849 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1850 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1851 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1852 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1853 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1854 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1855 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1856 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1857 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1858 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1859 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1860 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1861 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1862 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1863 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1864 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1865 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1866 ("eigs: unrecoverable exception encountered in dnaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1867 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1868 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1869 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1870 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1871 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1872 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1873 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1874 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1875 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1876 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1877 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1878 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1879 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1880 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1881 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1882 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1883 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1884 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1885 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1886 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1887 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1888 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1889 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1890 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1891 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1892 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1893 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1894 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1895 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1896 mtmp(i,0) = workd[i + iptr(0) - 1]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1897 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1898 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1899 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1900 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1901 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1902 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1903 else if (!vector_product (m, workd + iptr(0) - 1, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1904 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1905 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1906 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1907 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1908 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1909 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1910 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1911 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1912 ("eigs: error %d in dnaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1913 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1914 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1915 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1916 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1917 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1918 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1919 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1920 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1921 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1922 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1923 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1924 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1925 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1926 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1927 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1928 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1929 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
1930 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1931 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1932 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1933 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1934 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1935 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1936 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1937 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1938 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1939 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1940 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1941 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1942 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1943 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1944 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1945 for (octave_idx_type i = 0; i < k+1; i++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1946 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1947 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1948 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1949 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1950 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1951 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1952 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1953 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1954 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1955 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1956 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1957 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1958 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1959 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1960 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1961 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1962 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1963 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1964 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1965 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1966 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1967 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1968 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1969 for (octave_idx_type i = 0; i < k+1; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1970 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1971 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1972 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1973 else |
15020
560317fd5977
maint: Cuddle open bracket used for indexing C++ arrays in source code.
Rik <rik@octave.org>
parents:
15018
diff
changeset
|
1974 d[i-jj] = Complex (dr[i], di[i]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1975 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1976 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1977 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1978 d[i] = d[i+1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1979 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1980 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1981 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1982 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1983 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1984 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1985 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1986 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1987 eig_val.resize (k); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1988 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1989 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1990 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1991 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1992 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1993 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1994 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1995 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1996 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1997 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1998 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1999 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2000 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2001 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2002 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2003 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2004 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2005 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2006 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2007 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2008 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2009 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2010 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2011 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2012 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2013 while (i < k) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2014 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2015 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2016 octave_idx_type off2 = (i+1) * n; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2017 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2018 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2019 for (octave_idx_type j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2020 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2021 Complex (z[j+off1],0.); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2022 i++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2023 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2024 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2025 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2026 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2027 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2028 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2029 Complex (z[j+off1],z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2030 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2031 eig_vec(j,i+1) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2032 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2033 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2034 i+=2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2035 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2036 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2037 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2038 if (note3) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2039 eig_vec = ltsolve (M(b), permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2040 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2041 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2042 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2043 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2044 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2045 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2046 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2047 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2048 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2049 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2050 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2051 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2052 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2053 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2054 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2055 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2056 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2057 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2058 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2059 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2060 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2061 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2062 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2063 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2064 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2065 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2066 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2067 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2068 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2069 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2070 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2071 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2072 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2073 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2074 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2075 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2076 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2077 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2078 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2079 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2080 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2081 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2082 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2083 // FIXME: The "SM" type for mode 1 seems unstable though faster!! |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2084 //if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2085 // return EigsRealNonSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2086 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2087 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2088 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2089 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2090 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2091 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2092 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2093 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2094 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2095 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2096 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2097 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2098 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2099 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2100 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2101 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2102 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2103 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2104 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2105 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2106 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2107 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2108 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2109 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2110 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2111 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2112 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2113 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2114 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2115 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2116 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2117 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2118 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2119 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2120 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2121 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2122 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2123 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2124 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2125 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2126 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2127 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2128 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2129 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2130 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2131 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2132 // Check that we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2133 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2134 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2135 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2136 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2137 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2138 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2139 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2140 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2141 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2142 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2143 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2144 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2145 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2146 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2147 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2148 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2149 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2150 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2151 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2152 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2153 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2154 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2155 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2156 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2157 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2158 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2159 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2160 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2161 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2162 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2163 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2164 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2165 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2166 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2167 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2168 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2169 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2170 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2171 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2172 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2173 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2174 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2175 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2176 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2177 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2178 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2179 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2180 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2181 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2182 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2183 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2184 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2185 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2186 if (! LuAminusSigmaB (m, b, cholB, permB, sigmar, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2187 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2188 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2189 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2190 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2191 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2192 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2193 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2194 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2195 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2196 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2197 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2198 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2199 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2200 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2201 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2202 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2203 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2204 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2205 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2206 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2207 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2208 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2209 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2210 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2211 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2212 if (disp > 0 && !xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2213 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2214 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2215 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2216 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2217 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2218 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2219 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2220 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2221 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2222 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2223 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2224 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2225 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2226 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2227 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2228 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2229 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2230 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2231 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2232 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2233 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2234 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2235 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2236 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2237 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2238 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2239 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2240 vector_product (m, workd+iptr(0)-1, dtmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2241 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2242 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2243 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2244 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2245 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2246 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2247 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2248 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2249 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2250 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2251 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2252 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2253 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2254 vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2255 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2256 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2257 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2258 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2259 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2260 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2261 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2262 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2263 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2264 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2265 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2266 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2267 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2268 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2269 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2270 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2271 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2272 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2273 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2274 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2275 workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2276 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2277 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2278 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2279 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2280 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2281 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2282 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2283 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2284 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2285 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2286 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2287 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2288 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2289 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2290 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2291 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2292 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2293 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2294 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2295 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2296 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2297 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2298 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2299 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2300 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2301 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2302 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2303 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2304 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2305 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2306 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2307 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2308 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2309 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2310 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2311 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2312 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2313 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2314 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2315 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
2316 octave_idx_type *sel = s.fortran_vec (); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2317 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2318 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2319 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2320 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2321 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2322 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2323 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2324 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2325 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2326 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2327 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2328 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2329 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2330 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2331 for (octave_idx_type i = 0; i < k+1; i++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2332 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2333 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2334 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2335 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2336 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2337 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2338 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2339 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2340 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2341 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2342 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2343 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2344 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2345 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2346 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2347 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2348 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2349 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2350 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2351 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2352 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2353 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2354 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2355 for (octave_idx_type i = 0; i < k+1; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2356 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2357 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2358 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2359 else |
15020
560317fd5977
maint: Cuddle open bracket used for indexing C++ arrays in source code.
Rik <rik@octave.org>
parents:
15018
diff
changeset
|
2360 d[i-jj] = Complex (dr[i], di[i]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2361 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2362 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2363 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2364 d[i] = d[i+1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2365 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2366 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2367 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2368 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2369 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2370 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2371 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2372 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2373 eig_val.resize (k); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2374 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2375 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2376 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2377 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2378 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2379 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2380 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2381 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2382 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2383 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2384 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2385 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2386 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2387 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2388 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2389 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2390 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2391 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2392 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2393 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2394 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2395 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2396 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2397 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2398 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2399 while (i < k) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2400 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2401 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2402 octave_idx_type off2 = (i+1) * n; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2403 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2404 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2405 for (octave_idx_type j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2406 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2407 Complex (z[j+off1],0.); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2408 i++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2409 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2410 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2411 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2412 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2413 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2414 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2415 Complex (z[j+off1],z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2416 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2417 eig_vec(j,i+1) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2418 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2419 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2420 i+=2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2421 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2422 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2423 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2424 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2425 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2426 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2427 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2428 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2429 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2430 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2431 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2432 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2433 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2434 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2435 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2436 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2437 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2438 const std::string &_typ, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2439 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2440 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2441 ComplexColumnVector &eig_val, ColumnVector &resid, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
2442 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2443 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2444 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2445 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2446 bool have_sigma = (sigmar ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2447 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2448 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2449 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2450 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2451 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2452 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2453 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2454 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2455 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2456 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2457 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2458 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2459 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2460 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2461 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2462 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2463 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2464 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2465 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2466 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2467 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2468 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2469 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2470 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2471 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2472 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2473 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2474 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2475 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2476 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2477 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2478 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2479 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2480 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2481 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2482 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2483 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2484 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2485 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2486 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2487 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2488 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2489 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2490 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2491 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2492 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2493 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2494 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2495 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2496 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2497 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2498 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2499 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2500 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2501 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2502 if (typ == "LA" || typ == "SA" || typ == "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2503 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2504 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2505 ("eigs: invalid sigma value for unsymmetric problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2506 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2507 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2508 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2509 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2510 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2511 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2512 sigmar = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2513 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2514 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2515 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2516 else if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2517 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2518 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2519 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2520 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2521 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2522 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2523 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2524 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2525 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2526 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2527 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2528 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2529 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2530 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2531 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2532 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2533 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2534 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2535 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2536 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2537 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2538 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2539 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2540 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2541 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2542 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2543 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2544 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2545 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2546 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2547 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2548 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2549 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2550 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2551 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2552 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2553 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2554 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2555 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2556 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2557 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2558 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2559 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2560 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2561 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2562 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2563 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2564 ("eigs: unrecoverable exception encountered in dnaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2565 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2566 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2567 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2568 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2569 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2570 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2571 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2572 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2573 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2574 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2575 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2576 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2577 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2578 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2579 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2580 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2581 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2582 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2583 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2584 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2585 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2586 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2587 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2588 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2589 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2590 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2591 ColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2592 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2593 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2594 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2595 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2596 ColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2597 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2598 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2599 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2600 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2601 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2602 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2603 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2604 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2605 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2606 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2607 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2608 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2609 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2610 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2611 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2612 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2613 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2614 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2615 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2616 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2617 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2618 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2619 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2620 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2621 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2622 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2623 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2624 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2625 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2626 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2627 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
2628 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2629 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2630 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2631 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2632 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2633 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2634 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2635 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2636 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2637 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2638 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2639 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2640 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2641 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2642 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2643 for (octave_idx_type i = 0; i < k+1; i++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2644 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2645 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2646 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2647 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2648 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2649 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2650 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2651 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2652 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2653 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2654 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2655 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2656 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2657 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2658 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2659 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2660 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2661 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2662 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2663 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2664 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2665 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2666 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2667 for (octave_idx_type i = 0; i < k+1; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2668 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2669 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2670 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2671 else |
15020
560317fd5977
maint: Cuddle open bracket used for indexing C++ arrays in source code.
Rik <rik@octave.org>
parents:
15018
diff
changeset
|
2672 d[i-jj] = Complex (dr[i], di[i]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2673 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2674 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2675 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2676 d[i] = d[i+1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2677 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2678 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2679 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2680 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2681 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2682 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2683 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2684 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2685 eig_val.resize (k); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2686 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2687 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2688 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2689 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2690 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2691 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2692 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2693 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2694 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2695 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2696 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2697 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2698 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2699 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2700 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2701 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2702 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2703 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2704 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2705 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2706 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2707 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2708 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2709 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2710 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2711 while (i < k) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2712 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2713 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2714 octave_idx_type off2 = (i+1) * n; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2715 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2716 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2717 for (octave_idx_type j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2718 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2719 Complex (z[j+off1],0.); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2720 i++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2721 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2722 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2723 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2724 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2725 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2726 eig_vec(j,i) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2727 Complex (z[j+off1],z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2728 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2729 eig_vec(j,i+1) = |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2730 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2731 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2732 i+=2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2733 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2734 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2735 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2736 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2737 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2738 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2739 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2740 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2741 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2742 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2743 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2744 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2745 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2746 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2747 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2748 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2749 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2750 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2751 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2752 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2753 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2754 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2755 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2756 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2757 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2758 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2759 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2760 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2761 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2762 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2763 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2764 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2765 Complex sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2766 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2767 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2768 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2769 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2770 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2771 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2772 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2773 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2774 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2775 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2776 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2777 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2778 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2779 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2780 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2781 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2782 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2783 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2784 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2785 Array<double> ri (octave_rand::vector (n)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2786 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2787 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2788 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2789 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2790 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2791 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2792 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2793 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2794 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2795 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2796 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2797 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2798 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2799 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2800 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2801 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2802 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2803 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2804 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2805 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2806 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2807 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2808 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2809 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2810 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2811 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2812 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2813 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2814 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2815 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2816 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2817 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2818 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2819 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2820 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2821 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2822 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2823 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2824 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2825 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2826 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2827 // Check the we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2828 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2829 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2830 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2831 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2832 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2833 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2834 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2835 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2836 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2837 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2838 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2839 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2840 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2841 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2842 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2843 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2844 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2845 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2846 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2847 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2848 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2849 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2850 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2851 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2852 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2853 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2854 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2855 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2856 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2857 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2858 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2859 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2860 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2861 if (typ == "LA" || typ == "SA" || typ == "BE") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2862 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2863 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2864 ("eigs: invalid sigma value for complex problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2865 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2866 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2867 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2868 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2869 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2870 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2871 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2872 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2873 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2874 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2875 b = b.hermitian (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2876 if (permB.length () == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2877 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2878 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2879 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2880 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2881 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2882 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2883 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2884 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2885 if (! make_cholb (b, bt, permB)) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2886 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2887 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2888 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2889 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2890 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2891 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2892 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2893 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2894 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2895 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2896 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2897 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2898 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2899 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2900 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2901 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2902 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2903 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2904 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2905 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2906 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2907 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2908 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2909 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2910 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2911 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2912 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2913 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2914 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2915 octave_idx_type lwork = p * (3 * p + 5); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2916 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2917 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2918 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2919 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2920 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2921 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2922 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2923 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2924 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2925 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2926 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2927 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2928 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2929 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2930 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2931 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2932 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2933 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2934 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2935 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2936 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2937 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2938 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2939 if (disp > 0 && !xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2940 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2941 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2942 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2943 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2944 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2945 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2946 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2947 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2948 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2949 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2950 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2951 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2952 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2953 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2954 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2955 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2956 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2957 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2958 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2959 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2960 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2961 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2962 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2963 ComplexMatrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2964 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2965 mtmp(i,0) = workd[i + iptr(0) - 1]; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2966 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2967 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2968 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2969 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2970 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2971 else if (!vector_product (m, workd + iptr(0) - 1, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2972 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2973 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2974 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2975 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2976 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2977 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2978 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2979 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2980 ("eigs: error %d in znaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2981 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2982 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2983 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2984 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2985 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2986 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2987 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2988 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2989 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2990 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2991 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2992 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2993 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2994 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2995 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2996 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2997 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
2998 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2999 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3000 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3001 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3002 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3003 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3004 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3005 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3006 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3007 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3008 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3009 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3010 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3011 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3012 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3013 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3014 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3015 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3016 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3017 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3018 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3019 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3020 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3021 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3022 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3023 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3024 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3025 for (octave_idx_type i = 0; i < k2; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3026 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3027 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3028 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3029 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3030 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3031 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3032 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3033 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3034 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3035 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3036 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3037 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3038 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3039 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3040 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3041 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3042 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3043 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3044 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3045 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3046 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3047 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3048 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3049 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3050 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3051 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3052 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3053 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3054 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3055 if (note3) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3056 eig_vec = ltsolve (b, permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3057 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3058 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3059 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3060 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3061 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3062 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3063 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3064 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3065 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3066 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3067 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3068 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3069 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3070 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3071 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3072 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3073 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3074 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3075 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3076 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3077 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3078 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3079 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3080 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3081 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3082 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3083 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3084 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3085 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3086 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3087 if (m.rows () != m.cols ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3088 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3089 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3090 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3091 } |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3092 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3093 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3094 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3095 ("eigs: B must be square and the same size as A"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3096 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3097 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3098 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3099 // FIXME: The "SM" type for mode 1 seems unstable though faster!! |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3100 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3101 // return EigsComplexNonSymmetricMatrix (m, "SM", k, p, info, eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3102 // eig_val, _b, permB, cresid, os, tol, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3103 // rvec, cholB, disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3104 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3105 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3106 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3107 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3108 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3109 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3110 Array<double> ri (octave_rand::vector (n)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3111 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3112 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3113 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3114 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3115 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3116 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3117 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3118 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3119 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3120 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3121 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3122 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3123 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3124 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3125 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3126 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3127 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3128 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3129 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3130 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3131 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3132 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3133 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3134 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3135 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3136 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3137 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3138 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3139 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3140 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3141 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3142 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3143 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3144 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3145 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3146 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3147 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3148 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3149 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3150 if (have_b && cholB && permB.length () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3151 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3152 // Check that we really have a permutation vector |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3153 if (permB.length () != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3154 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3155 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3156 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3157 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3158 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3159 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3160 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3161 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3162 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3163 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3164 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3165 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3166 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3167 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3168 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3169 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3170 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3171 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3172 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3173 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3174 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3175 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3176 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3177 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3178 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3179 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3180 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3181 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3182 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3183 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3184 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3185 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3186 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3187 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3188 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3189 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3190 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3191 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3192 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3193 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3194 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3195 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3196 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3197 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3198 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3199 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3200 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3201 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3202 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3203 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3204 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3205 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3206 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3207 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3208 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3209 octave_idx_type lwork = p * (3 * p + 5); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3210 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3211 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3212 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3213 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3214 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3215 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3216 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3217 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3218 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3219 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3220 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3221 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3222 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3223 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3224 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3225 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3226 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3227 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3228 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3229 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3230 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3231 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3232 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3233 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3234 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3235 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3236 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3237 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3238 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3239 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3240 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3241 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3242 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3243 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3244 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3245 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3246 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3247 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3248 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3249 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3250 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3251 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3252 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3253 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3254 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3255 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3256 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3257 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3258 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3259 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3260 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3261 vector_product (m, workd+iptr(0)-1, ctmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3262 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3263 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3264 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3265 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3266 tmp(i,0) = ctmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3267 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3268 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3269 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3270 Complex *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3271 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3272 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3273 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3274 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3275 vector_product (b, workd + iptr(0) - 1, workd + iptr(1) - 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3276 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3277 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3278 Complex *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3279 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3280 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3281 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3282 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3283 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3284 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3285 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3286 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3287 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3288 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3289 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3290 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3291 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3292 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3293 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3294 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3295 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3296 workd[iptr(0) + i - 1] = |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3297 workd[iptr(1) + i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3298 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3299 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3300 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3301 Complex *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3302 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3303 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3304 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3305 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3306 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3307 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3308 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3309 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3310 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3311 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3312 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3313 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3314 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3315 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3316 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3317 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3318 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3319 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3320 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3321 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3322 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3323 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3324 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3325 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3326 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3327 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3328 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3329 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3330 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3331 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3332 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3333 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3334 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3335 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3336 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3337 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
3338 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3339 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3340 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3341 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3342 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3343 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3344 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3345 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3346 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3347 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3348 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3349 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3350 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3351 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3352 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3353 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3354 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3355 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3356 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3357 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3358 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3359 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3360 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3361 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3362 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3363 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3364 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3365 for (octave_idx_type i = 0; i < k2; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3366 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3367 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3368 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3369 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3370 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3371 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3372 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3373 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3374 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3375 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3376 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3377 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3378 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3379 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3380 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3381 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3382 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3383 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3384 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3385 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3386 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3387 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3388 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3389 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3390 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3391 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3392 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3393 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3394 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3395 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3396 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3397 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3398 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3399 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3400 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3401 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3402 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3403 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3404 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3405 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3406 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3407 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3408 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3409 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3410 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3411 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3412 ComplexColumnVector &cresid, std::ostream& os, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3413 double tol, bool rvec, bool /* cholB */, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3414 int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3415 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3416 std::string typ (_typ); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3417 bool have_sigma = (std::abs (sigma) ? true : false); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3418 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3419 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3420 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3421 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3422 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3423 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3424 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3425 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3426 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3427 Array<double> ri (octave_rand::vector (n)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3428 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3429 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3430 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3431 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3432 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3433 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3434 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3435 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3436 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3437 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3438 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3439 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3440 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3441 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3442 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3443 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3444 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3445 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3446 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3447 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3448 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3449 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3450 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3451 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3452 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3453 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3454 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3455 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3456 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3457 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3458 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3459 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3460 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3461 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3462 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3463 ("eigs: opts.p must be greater than k and less than n"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3464 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3465 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3466 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3467 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3468 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3469 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3470 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3471 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3472 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3473 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3474 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3475 if (typ == "LA" || typ == "SA" || typ == "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3476 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3477 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3478 ("eigs: invalid sigma value for complex problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3479 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3480 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3481 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3482 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3483 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3484 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3485 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3486 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3487 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3488 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3489 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3490 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3491 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3492 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3493 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3494 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3495 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3496 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3497 Array<octave_idx_type> ip (dim_vector (11, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3498 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3499 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3500 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3501 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3502 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3503 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3504 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3505 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3506 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3507 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3508 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3509 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3510 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3511 // ip(7) to ip(10) return values |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3512 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3513 Array<octave_idx_type> iptr (dim_vector (14, 1)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3514 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3515 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3516 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3517 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3518 octave_idx_type lwork = p * (3 * p + 5); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3519 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3520 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3521 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3522 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3523 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3524 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3525 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3526 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3527 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3528 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3529 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3530 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3531 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3532 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3533 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3534 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3535 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3536 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3537 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3538 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3539 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3540 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3541 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3542 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3543 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3544 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3545 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3546 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3547 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3548 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3549 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3550 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3551 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3552 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3553 // This is a kludge, as ARPACK doesn't give its |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3554 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3555 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3556 // a value in this array to NaN and testing for it |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3557 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3558 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3559 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3560 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3561 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3562 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3563 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3564 Complex *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3565 ComplexColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3566 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3567 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3568 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3569 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3570 ComplexColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3571 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3572 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3573 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3574 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3575 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3576 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3577 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3578 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3579 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3580 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3581 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3582 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3583 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3584 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3585 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3586 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3587 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3588 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3589 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3590 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3591 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3592 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3593 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3594 // We have a problem in that the size of the C++ bool |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3595 // type relative to the fortran logical type. It appears |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3596 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3597 // per bool, though this might be system dependent. As |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3598 // long as the HOWMNY arg is not "S", the logical array |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3599 // is just workspace for ARPACK, so use int type to |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3600 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3601 Array<octave_idx_type> s (dim_vector (p, 1)); |
9391
333b31ce3434
eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents:
9228
diff
changeset
|
3602 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3603 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3604 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3605 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3606 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3607 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3608 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3609 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3610 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3611 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3612 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3613 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3614 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3615 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3616 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3617 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3618 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3619 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3620 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3621 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3622 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3623 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3624 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3625 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3626 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3627 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3628 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3629 for (octave_idx_type i = 0; i < k2; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3630 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3631 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3632 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3633 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3634 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3635 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3636 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3637 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3638 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3639 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3640 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3641 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3642 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3643 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3644 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3645 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3646 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3647 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3648 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3649 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3650 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3651 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3652 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3653 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3654 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3655 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3656 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3657 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3658 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3659 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3660 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3661 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3662 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3663 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3664 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3665 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3666 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3667 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3668 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3669 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3670 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3671 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3672 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3673 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3674 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3675 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3676 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3677 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3678 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3679 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3680 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3681 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3682 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3683 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3684 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3685 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3686 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3687 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3688 std::ostream& os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3689 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3690 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3691 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3692 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3693 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3694 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3695 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3696 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3697 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3698 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3699 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3700 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3701 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3702 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3703 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3704 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3705 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3706 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3707 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3708 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3709 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3710 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3711 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3712 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3713 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3714 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3715 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3716 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3717 const std::string &typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3718 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3719 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3720 Matrix &eig_vec, ColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3721 ColumnVector &resid, std::ostream &os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3722 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3723 bool rvec = false, bool cholB = 0, int disp = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3724 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3725 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3726 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3727 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3728 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3729 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3730 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3731 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3732 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3733 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3734 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3735 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3736 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3737 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3738 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3739 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3740 octave_idx_type &info, ComplexMatrix &eig_vec, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3741 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3742 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3743 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3744 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3745 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3746 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3747 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3748 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3749 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3750 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3751 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3752 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3753 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3754 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3755 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3756 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3757 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3758 bool rvec = false, bool cholB = 0, |
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3759 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3760 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3761 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3762 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3763 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3764 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3765 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3766 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3767 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3768 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3769 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3770 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3771 bool rvec = false, bool cholB = 0, |
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3772 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3773 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3774 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3775 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3776 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3777 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3778 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3779 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3780 ColumnVector &resid, std::ostream& os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3781 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3782 bool rvec = false, bool cholB = 0, int disp = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3783 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3784 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3785 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3786 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3787 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3788 octave_idx_type &info, ComplexMatrix &eig_vec, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3789 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3790 const ComplexMatrix& b, ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3791 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3792 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3793 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3794 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3795 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3796 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3797 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3798 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3799 const std::string typ, octave_idx_type k, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3800 octave_idx_type p, octave_idx_type &info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3801 ComplexMatrix &eig_vec, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3802 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3803 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3804 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3805 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3806 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3807 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3808 bool rvec = false, bool cholB = 0, int disp = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3809 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3810 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3811 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3812 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3813 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3814 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3815 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3816 ComplexColumnVector &eig_val, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3817 const ComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3818 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3819 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3820 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3821 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3822 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3823 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3824 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3825 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3826 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3827 Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3828 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3829 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3830 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3831 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3832 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3833 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3834 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3835 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3836 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3837 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3838 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3839 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3840 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3841 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3842 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3843 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3844 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3845 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3846 ComplexColumnVector &resid, std::ostream& os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3847 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3848 bool rvec = false, bool cholB = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3849 int disp = 0, int maxit = 300); |
14144
834df9f10963
remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
3850 #endif |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3851 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3852 #ifndef _MSC_VER |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3853 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3854 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3855 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3856 template octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3857 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3858 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3859 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3860 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3861 lusolve (const Matrix&, const Matrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3862 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3863 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3864 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3865 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3866 template ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3867 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3868 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3869 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3870 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3871 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3872 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3873 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3874 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3875 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3876 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3877 ltsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3878 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3879 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3880 utsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3881 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3882 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3883 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3884 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3885 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3886 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3887 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3888 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3889 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3890 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3891 #endif |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3892 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3893 #endif |