Mercurial > octave
annotate liboctave/eigs-base.cc @ 12195:d25dfa9ed18b
remove configure checks for ARPACK
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Fri, 28 Jan 2011 14:05:09 -0500 |
parents | 12df7854fa7c |
children | 30ca5a0b0e2f |
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 |
11523 | 3 Copyright (C) 2005-2011 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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
47 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
|
48 typedef ComplexColumnVector (*EigsComplexFunc) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
49 (const ComplexColumnVector &x, int &eigs_error); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
50 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
51 // Arpack and blas fortran functions we call. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
52 extern "C" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
53 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
54 F77_RET_T |
11518 | 55 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&, |
56 F77_CONST_CHAR_ARG_DECL, | |
57 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
58 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
59 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
60 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
61 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
|
62 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
63 const octave_idx_type&, octave_idx_type& |
11518 | 64 F77_CHAR_ARG_LEN_DECL |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
65 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
66 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
67 F77_RET_T |
11518 | 68 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&, |
69 F77_CONST_CHAR_ARG_DECL, | |
70 octave_idx_type*, double*, double*, | |
71 const octave_idx_type&, const double&, | |
72 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
73 const octave_idx_type&, |
11518 | 74 F77_CONST_CHAR_ARG_DECL, |
75 const octave_idx_type&, const double&, double*, | |
76 const octave_idx_type&, double*, | |
77 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
|
78 octave_idx_type*, double*, double*, |
11518 | 79 const octave_idx_type&, octave_idx_type& |
80 F77_CHAR_ARG_LEN_DECL | |
81 F77_CHAR_ARG_LEN_DECL | |
82 F77_CHAR_ARG_LEN_DECL); | |
83 | |
84 F77_RET_T | |
85 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&, | |
86 F77_CONST_CHAR_ARG_DECL, | |
87 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
88 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
89 octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
90 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
91 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
|
92 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
93 const octave_idx_type&, octave_idx_type& |
11518 | 94 F77_CHAR_ARG_LEN_DECL |
95 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
96 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
97 F77_RET_T |
11518 | 98 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&, |
99 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
100 octave_idx_type*, double*, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
101 double*, const octave_idx_type&, const double&, |
11518 | 102 const double&, double*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
103 F77_CONST_CHAR_ARG_DECL, |
11518 | 104 const octave_idx_type&, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
105 F77_CONST_CHAR_ARG_DECL, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
106 octave_idx_type&, const double&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
107 const octave_idx_type&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
108 const octave_idx_type&, octave_idx_type*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
109 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
110 const octave_idx_type&, octave_idx_type& |
11518 | 111 F77_CHAR_ARG_LEN_DECL |
112 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
113 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
114 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
115 F77_RET_T |
11518 | 116 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&, |
117 F77_CONST_CHAR_ARG_DECL, | |
118 const octave_idx_type&, | |
119 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
120 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
121 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
122 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
|
123 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
124 const octave_idx_type&, double *, octave_idx_type& |
11518 | 125 F77_CHAR_ARG_LEN_DECL |
126 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
127 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
128 F77_RET_T |
11518 | 129 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&, |
130 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
131 octave_idx_type*, Complex*, Complex*, |
11518 | 132 const octave_idx_type&, const Complex&, Complex*, |
133 F77_CONST_CHAR_ARG_DECL, | |
134 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
135 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
136 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
137 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
138 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
|
139 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
140 const octave_idx_type&, double *, octave_idx_type& |
11518 | 141 F77_CHAR_ARG_LEN_DECL |
142 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
143 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
144 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
145 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
146 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, |
11518 | 147 const octave_idx_type&, const octave_idx_type&, |
148 const double&, const double*, | |
149 const octave_idx_type&, const double*, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
150 const octave_idx_type&, const double&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
151 const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
152 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
153 |
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 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
156 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
157 const octave_idx_type&, const octave_idx_type&, const Complex&, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
158 const Complex*, const octave_idx_type&, const Complex*, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
159 const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
160 F77_CHAR_ARG_LEN_DECL); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
161 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
162 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
163 |
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 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
166 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
167 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
168 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
169 static octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
170 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
171 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
172 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
173 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
174 lusolve (const Matrix&, const Matrix&, Matrix&); |
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 ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
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 ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
180 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
181 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
182 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
183 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
184 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,); |
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 ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
187 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
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 Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
190 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,); |
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 ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
193 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
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 Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
196 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
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 ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
199 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
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 Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
202 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
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 template <class M, class SM> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
205 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
206 lusolve (const SM& L, const SM& U, M& m) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
207 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
208 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
209 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
210 MatrixType utyp (MatrixType::Upper); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
211 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
212 // 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
|
213 m = L.solve (m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
214 if (err) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
215 return err; |
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 m = U.solve (utyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
218 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
219 return err; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
220 } |
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 template <class SM, class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
223 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
224 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
|
225 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
226 octave_idx_type n = L.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
227 octave_idx_type b_nc = m.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
228 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
229 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
230 MatrixType ltyp (MatrixType::Lower); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
231 M tmp = L.solve (ltyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
232 M retval; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
233 const double* qv = Q.fortran_vec(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
234 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
235 if (!err) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
236 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
237 retval.resize (n, b_nc); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
238 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
|
239 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
240 for (octave_idx_type i = 0; i < n; i++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
241 retval.elem(static_cast<octave_idx_type>(qv[i]), j) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
242 tmp.elem(i,j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
243 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
244 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
245 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
246 return retval; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
247 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
248 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
249 template <class SM, class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
250 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
251 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
|
252 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
253 octave_idx_type n = U.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
254 octave_idx_type b_nc = m.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
255 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
256 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
257 MatrixType utyp (MatrixType::Upper); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
258 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
259 M retval (n, b_nc); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
260 const double* qv = Q.fortran_vec(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
261 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
|
262 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
263 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
|
264 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
|
265 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
266 return U.solve (utyp, retval, err, rcond, 0); |
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
269 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
270 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
|
271 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
272 octave_idx_type nc = m.cols (); |
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 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
275 y[j] = 0.; |
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 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
278 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
279 y[m.ridx(i)] += m.data(i) * x[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
280 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
281 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
282 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
283 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
284 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
285 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
|
286 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
287 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
288 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
289 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
290 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
|
291 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
292 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
293 F77_CHAR_ARG_LEN (1))); |
8417
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 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
296 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
297 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
298 ("eigs: unrecoverable error in dgemv"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
299 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
300 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
301 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
302 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
303 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
304 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
305 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
306 vector_product (const SparseComplexMatrix& m, const Complex* x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
307 Complex* y) |
8417
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 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
310 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
311 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
312 y[j] = 0.; |
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 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
315 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
316 y[m.ridx(i)] += m.data(i) * x[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
317 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
318 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
319 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
320 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
321 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
322 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
|
323 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
324 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
325 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
326 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
327 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
|
328 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
329 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
330 F77_CHAR_ARG_LEN (1))); |
8417
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 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
333 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
334 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
335 ("eigs: unrecoverable error in zgemv"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
336 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
337 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
338 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
339 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
340 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
341 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
342 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
343 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
344 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
345 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
346 CHOL fact (b, info); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
347 octave_idx_type n = b.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
348 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
349 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
350 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
351 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
352 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
353 bt = fact.chol_matrix (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
354 b = bt.transpose(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
355 permB = ColumnVector(n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
356 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
|
357 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
358 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
359 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
360 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
361 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
362 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
363 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB) |
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 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
366 SparseCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
367 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
368 if (fact.P() != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
369 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
370 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
371 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
372 b = fact.L(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
373 bt = b.transpose(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
374 permB = fact.perm() - 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
375 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
376 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
377 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
378 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
379 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
380 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB) |
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 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
383 ComplexCHOL fact (b, info); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
384 octave_idx_type n = b.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
385 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
386 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
387 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
388 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
389 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
390 bt = fact.chol_matrix (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
391 b = bt.hermitian(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
392 permB = ColumnVector(n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
393 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
|
394 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
395 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
396 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
397 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
398 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
399 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
400 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
401 ColumnVector& permB) |
8417
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 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
404 SparseComplexCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
405 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
406 if (fact.P() != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
407 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
408 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
409 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
410 b = fact.L(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
411 bt = b.hermitian(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
412 permB = fact.perm() - 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
413 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
414 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
415 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
416 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
417 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
418 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
419 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
|
420 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
421 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
422 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
423 bool have_b = ! b.is_empty (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
424 octave_idx_type n = m.rows(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
425 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
426 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
427 SparseMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
428 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
429 if (have_b) |
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 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
432 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
433 if (permB.length()) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
434 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
435 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
436 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
437 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
438 tmp.xcidx(i) = i; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
439 tmp.xridx(i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
440 static_cast<octave_idx_type>(permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
441 tmp.xdata(i) = 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
442 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
443 tmp.xcidx(n) = n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
444 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
445 AminusSigmaB = AminusSigmaB - sigma * tmp * |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
446 b.transpose() * b * tmp.transpose(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
447 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
448 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
449 AminusSigmaB = AminusSigmaB - sigma * |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
450 b.transpose() * b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
451 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
452 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
453 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
454 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
455 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
456 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
457 SparseMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
458 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
459 // Create sigma * speye(n,n) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
460 sigmat.xcidx (0) = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
461 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
462 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
463 sigmat.xdata(i) = sigma; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
464 sigmat.xridx(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
465 sigmat.xcidx(i+1) = i + 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
466 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
467 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
468 AminusSigmaB = AminusSigmaB - sigmat; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
469 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
470 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
471 SparseLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
472 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
473 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
474 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
475 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
476 const octave_idx_type *Q2 = fact.col_perm (); |
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 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
479 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
480 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
481 Q[j] = Q2[j]; |
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
484 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
485 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
486 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
487 for (octave_idx_type j = 0; j < n; j++) |
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 double d = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
490 if (U.xcidx(j+1) > U.xcidx(j) && |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
491 U.xridx (U.xcidx(j+1)-1) == j) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
492 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
|
493 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
494 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
495 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
496 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
497 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
498 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
499 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
500 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
501 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
502 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
503 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
504 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
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 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
507 ("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
|
508 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
509 (" an eigenvalue. Convergence is not guaranteed"); |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
512 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
513 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
514 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
515 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
516 LuAminusSigmaB (const Matrix &m, const Matrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
517 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
|
518 Matrix &L, Matrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
519 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
520 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
521 bool have_b = ! b.is_empty (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
522 octave_idx_type n = m.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
523 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
524 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
525 Matrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
526 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
527 if (have_b) |
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 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
530 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
531 Matrix tmp = sigma * b.transpose() * b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
532 const double *pB = permB.fortran_vec(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
533 double *p = AminusSigmaB.fortran_vec(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
534 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
535 if (permB.length()) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
536 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
537 for (octave_idx_type j = 0; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
538 j < b.cols(); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
539 for (octave_idx_type i = 0; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
540 i < b.rows(); i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
541 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
542 static_cast<octave_idx_type>(pB[j])); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
543 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
544 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
545 AminusSigmaB = AminusSigmaB - tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
546 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
547 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
548 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
549 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
550 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
551 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
552 double *p = AminusSigmaB.fortran_vec(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
553 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
554 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
|
555 p[i*(n+1)] -= sigma; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
556 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
557 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
558 LU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
559 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
560 L = fact.P().transpose() * fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
561 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
562 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
|
563 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
564 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
565 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
566 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
567 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
568 for (octave_idx_type j = 0; j < n; j++) |
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 double d = std::abs (U.xelem(j,j)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
571 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
572 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
573 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
574 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
575 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
576 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
577 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
578 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
579 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
580 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
581 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
582 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
583 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
584 ("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
|
585 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
586 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
587 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
588 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
589 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
590 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
591 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
592 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
593 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
594 bool cholB, const ColumnVector& permB, Complex sigma, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
595 SparseComplexMatrix &L, SparseComplexMatrix &U, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
596 octave_idx_type *P, octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
597 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
598 bool have_b = ! b.is_empty (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
599 octave_idx_type n = m.rows(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
600 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
601 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
602 SparseComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
603 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
604 if (have_b) |
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 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
607 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
608 if (permB.length()) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
609 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
610 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
611 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
612 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
613 tmp.xcidx(i) = i; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
614 tmp.xridx(i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
615 static_cast<octave_idx_type>(permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
616 tmp.xdata(i) = 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
617 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
618 tmp.xcidx(n) = n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
619 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
620 AminusSigmaB = AminusSigmaB - tmp * b.hermitian() * b * |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
621 tmp.transpose() * sigma; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
622 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
623 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
624 AminusSigmaB = AminusSigmaB - sigma * b.hermitian() * b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
625 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
626 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
627 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
628 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
629 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
630 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
631 SparseComplexMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
632 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
633 // Create sigma * speye(n,n) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
634 sigmat.xcidx (0) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
635 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
|
636 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
637 sigmat.xdata(i) = sigma; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
638 sigmat.xridx(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
639 sigmat.xcidx(i+1) = i + 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
640 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
641 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
642 AminusSigmaB = AminusSigmaB - sigmat; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
643 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
644 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
645 SparseComplexLU fact (AminusSigmaB); |
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 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
648 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
649 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
650 const octave_idx_type *Q2 = fact.col_perm (); |
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 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
653 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
654 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
655 Q[j] = Q2[j]; |
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
658 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
659 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
660 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
661 for (octave_idx_type j = 0; j < n; j++) |
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 double d = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
664 if (U.xcidx(j+1) > U.xcidx(j) && |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
665 U.xridx (U.xcidx(j+1)-1) == j) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
666 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
|
667 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
668 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
669 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
670 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
671 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
672 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
673 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
674 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
675 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
676 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
677 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
678 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
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 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
681 ("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
|
682 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
683 (" an eigenvalue. Convergence is not guaranteed"); |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
686 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
687 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
688 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
689 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
690 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
691 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
|
692 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
693 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
694 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
695 bool have_b = ! b.is_empty (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
696 octave_idx_type n = m.cols(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
697 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
698 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
699 ComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
700 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
701 if (have_b) |
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 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
704 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
705 ComplexMatrix tmp = sigma * b.hermitian() * b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
706 const double *pB = permB.fortran_vec(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
707 Complex *p = AminusSigmaB.fortran_vec(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
708 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
709 if (permB.length()) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
710 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
711 for (octave_idx_type j = 0; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
712 j < b.cols(); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
713 for (octave_idx_type i = 0; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
714 i < b.rows(); i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
715 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
716 static_cast<octave_idx_type>(pB[j])); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
717 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
718 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
719 AminusSigmaB = AminusSigmaB - tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
720 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
721 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
722 AminusSigmaB = AminusSigmaB - sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
723 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
724 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
725 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
726 Complex *p = AminusSigmaB.fortran_vec(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
727 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
728 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
|
729 p[i*(n+1)] -= sigma; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
730 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
731 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
732 ComplexLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
733 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
734 L = fact.P().transpose() * fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
735 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
736 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
|
737 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
738 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
739 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
740 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
741 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
742 for (octave_idx_type j = 0; j < n; j++) |
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 double d = std::abs (U.xelem(j,j)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
745 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
746 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
747 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
748 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
749 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
750 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
751 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
752 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
753 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
754 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
755 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
756 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
757 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
758 ("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
|
759 (*current_liboctave_warning_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
760 (" an eigenvalue. Convergence is not guaranteed"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
761 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
762 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
763 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
764 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
765 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
766 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
767 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
768 EigsRealSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
769 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
770 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
771 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
772 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
773 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
774 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
775 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
776 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
777 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
778 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
779 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
780 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
781 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
782 double sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
783 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
784 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
785 if (m.rows() != m.cols()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
786 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
787 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
788 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
789 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
790 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
791 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
792 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
793 ("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
|
794 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
795 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
796 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
797 if (resid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
798 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
799 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
800 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
801 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
802 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
803 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
804 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
805 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
806 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
807 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
808 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
809 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
810 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
811 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
812 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
813 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
814 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
815 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
816 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
817 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
818 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
819 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
820 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
821 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
822 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
823 if (k < 1 || k > n - 2) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
824 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
825 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
826 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
827 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
828 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
829 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
830 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
831 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
832 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
833 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
834 ("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
|
835 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
836 } |
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 if (have_b && cholB && permB.length() != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
839 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
840 // Check the we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
841 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
842 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
843 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
844 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
845 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
846 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
847 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
848 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
849 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
850 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
851 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
852 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
853 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
854 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
855 bidx >= n || D_NINT (bidx) != bidx) |
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 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
858 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
859 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
860 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
861 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
862 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
863 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
864 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
865 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
|
866 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
867 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
868 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
869 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
870 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
871 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
872 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
873 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
874 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
875 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
876 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
877 ("eigs: invalid sigma value for real symmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
878 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
879 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
880 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
881 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
882 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
883 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
884 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
885 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
886 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
887 bt = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
888 b = b.transpose(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
889 if (permB.length() == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
890 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
891 permB = ColumnVector(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
892 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
893 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
894 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
895 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
896 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
897 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
898 if (! make_cholb(b, bt, permB)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
899 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
900 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
901 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
902 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
903 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
904 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
905 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
906 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
907 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
|
908 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
909 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
910 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
911 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
912 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
913 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
914 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
|
915 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
916 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
917 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
918 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
919 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
920 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
921 // 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
|
922 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
923 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
|
924 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
925 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
926 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
927 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
928 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
929 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
930 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
931 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
932 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
933 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
934 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
935 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
936 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
937 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
938 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
939 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
940 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
941 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
942 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
|
943 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
944 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
945 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
946 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
947 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
948 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
949 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
950 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
951 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
952 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
953 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
954 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
955 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
956 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
957 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
958 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
959 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
960 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
961 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
962 // 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
|
963 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
964 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
965 // 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
|
966 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
967 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
968 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
969 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
970 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
971 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
972 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
973 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
974 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
975 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
976 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
977 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
|
978 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
979 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
980 |
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 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
983 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
984 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
|
985 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
986 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
987 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
988 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
989 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
990 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
991 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
992 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
993 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
994 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
995 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
996 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
997 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
998 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
999 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1000 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1001 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1002 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1003 // 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
|
1004 // 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
|
1005 // 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
|
1006 // 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
|
1007 // 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
|
1008 // 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
|
1009 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1010 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
|
1011 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
|
1012 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1013 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1014 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1015 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1016 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1017 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1018 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1019 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1020 (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
|
1021 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1022 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
|
1023 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
|
1024 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1025 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1026 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1027 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1028 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1029 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1030 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1031 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1032 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1033 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1034 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1035 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1036 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1037 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1038 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1039 for (octave_idx_type i = 0; i < k2; i++) |
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 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1042 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1043 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1044 } |
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1047 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1048 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1049 if (typ != "SM" && typ != "BE") |
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 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1052 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1053 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1054 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1055 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1056 octave_idx_type off2 = (k - i - 1) * 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 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1059 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1060 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1061 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1062 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1063 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1064 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1065 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1066 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1067 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1068 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1069 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1070 } |
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 if (note3) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1073 eig_vec = ltsolve(b, permB, eig_vec); |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1076 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1077 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1078 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1079 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1080 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1081 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1082 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1083 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1084 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1085 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1086 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1087 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1088 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1089 EigsRealSymmetricMatrixShift (const M& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1090 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
|
1091 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1092 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1093 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1094 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1095 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1096 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1097 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1098 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1099 octave_idx_type mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1100 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1101 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1102 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1103 if (m.rows() != m.cols()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1104 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1105 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1106 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1107 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1108 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1109 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1110 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1111 ("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
|
1112 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1113 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1114 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1115 // 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
|
1116 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1117 // 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
|
1118 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1119 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1120 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1121 if (resid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1122 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1123 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1124 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1125 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1126 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1127 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1128 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1129 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1130 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1131 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1132 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1133 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1134 } |
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 if (k <= 0 || k >= n - 1) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1137 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1138 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1139 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1140 " Use 'eig(full(A))' instead"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1141 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1142 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1143 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1144 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1145 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1146 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1147 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1148 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1149 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1150 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1151 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1152 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1153 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1154 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1155 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1156 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1157 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1158 ("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
|
1159 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1160 } |
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 if (have_b && cholB && permB.length() != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1163 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1164 // Check the we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1165 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1166 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1167 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1168 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1169 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1170 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1171 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1172 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1173 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1174 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1175 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1176 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1177 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1178 bidx >= n || D_NINT (bidx) != bidx) |
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 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1181 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1182 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1183 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1184 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1185 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1186 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1187 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1188 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1189 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1190 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1191 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1192 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
|
1193 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1194 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1195 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1196 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1197 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1198 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1199 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
|
1200 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1201 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1202 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1203 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1204 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1205 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1206 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1207 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1208 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
|
1209 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1210 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1211 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1212 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1213 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1214 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1215 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1216 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1217 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1218 if (! LuAminusSigmaB(m, b, cholB, permB, sigma, L, U, P, Q)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1219 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1220 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1221 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1222 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1223 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1224 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1225 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1226 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1227 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1228 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1229 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1230 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1231 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1232 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1233 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1234 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1235 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
|
1236 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1237 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1238 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1239 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1240 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1241 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1242 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1243 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1244 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1245 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1246 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1247 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1248 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1249 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1250 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1251 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1252 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1253 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1254 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1255 // 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
|
1256 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1257 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1258 // 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
|
1259 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1260 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1261 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1262 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1263 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1264 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1265 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1266 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1267 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1268 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1269 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1270 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1271 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1272 vector_product (m, workd+iptr(0)-1, dtmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1273 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1274 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1275 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1276 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1277 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1278 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1279 lusolve (L, U, tmp); |
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 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1282 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1283 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1284 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1285 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1286 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
|
1287 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1288 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1289 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1290 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1291 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1292 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1293 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1294 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1295 lusolve (L, U, tmp); |
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 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1298 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1299 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1300 } |
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 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1303 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1304 if (ido == 2) |
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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1307 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
|
1308 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1309 else |
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 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1312 Matrix tmp(n, 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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1315 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1316 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1317 lusolve (L, U, tmp); |
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 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1320 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1321 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1322 } |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1325 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1326 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1327 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1328 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1329 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1330 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1331 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1332 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1333 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1334 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1335 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1336 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1337 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1338 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1339 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1340 // 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
|
1341 // 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
|
1342 // 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
|
1343 // 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
|
1344 // 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
|
1345 // 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
|
1346 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1347 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
|
1348 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
|
1349 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1350 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1351 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1352 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1353 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1354 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1355 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1356 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1357 (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
|
1358 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1359 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1360 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
|
1361 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
|
1362 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1363 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1364 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1365 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1366 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1367 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1368 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1369 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1370 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1371 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1372 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1373 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1374 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1375 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1376 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1377 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1378 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1379 } |
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 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1382 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1383 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
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 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1386 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1387 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1388 octave_idx_type off2 = (k - i - 1) * 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 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1391 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1392 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1393 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1394 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1395 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1396 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1397 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1398 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1399 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1400 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1401 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1402 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1403 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1404 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1405 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1406 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1407 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1408 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1409 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1410 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1411 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1412 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1413 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1414 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1415 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1416 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1417 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1418 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
|
1419 octave_idx_type &info, Matrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1420 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
|
1421 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1422 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1423 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1424 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1425 bool have_sigma = (sigma ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1426 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1427 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1428 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1429 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1430 if (resid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1431 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1432 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1433 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1434 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1435 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1436 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1437 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1438 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1439 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1440 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1441 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1442 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1443 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1444 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1445 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1446 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1447 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1448 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1449 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1450 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1451 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1452 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1453 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1454 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1455 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1456 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1457 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1458 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1459 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1460 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1461 return -1; |
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 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1464 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1465 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1466 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1467 ("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
|
1468 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1469 } |
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 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1472 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1473 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
|
1474 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1475 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1476 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1477 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1478 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1479 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
|
1480 { |
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: invalid sigma value for real symmetric problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1483 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1484 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1485 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1486 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1487 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1488 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1489 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1490 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1491 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1492 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1493 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1494 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1495 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1496 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1497 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1498 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1499 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1500 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1501 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
|
1502 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1503 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1504 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1505 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1506 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1507 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1508 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
|
1509 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1510 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1511 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1512 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1513 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1514 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1515 // 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
|
1516 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1517 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
|
1518 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1519 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1520 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1521 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1522 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1523 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1524 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1525 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1526 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1527 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1528 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1529 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1530 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1531 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1532 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1533 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1534 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1535 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1536 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
|
1537 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1538 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1539 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1540 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1541 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1542 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1543 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1544 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1545 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1546 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1547 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1548 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1549 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1550 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1551 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1552 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1553 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1554 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1555 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1556 // 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
|
1557 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1558 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1559 // 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
|
1560 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1561 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1562 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1563 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1564 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1565 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1566 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1567 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1568 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1569 ColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1570 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1571 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1572 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1573 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1574 ColumnVector y = fun (x, err); |
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 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1577 return false; |
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 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1580 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1581 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1582 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1583 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1584 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1585 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1586 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1587 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1588 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1589 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1590 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1591 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1592 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1593 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1594 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1595 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1596 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1597 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1598 // 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
|
1599 // 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
|
1600 // 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
|
1601 // 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
|
1602 // 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
|
1603 // 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
|
1604 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1605 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
|
1606 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
|
1607 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1608 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1609 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1610 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1611 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1612 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1613 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1614 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1615 (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
|
1616 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1617 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1618 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
|
1619 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
|
1620 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1621 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1622 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1623 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1624 ("eigs: unrecoverable exception encountered in dseupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1625 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1626 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1627 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1628 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1629 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1630 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1631 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1632 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1633 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1634 for (octave_idx_type i = 0; i < k2; i++) |
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 double dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1637 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1638 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1639 } |
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1642 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1643 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1644 if (typ != "SM" && typ != "BE") |
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 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1647 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1648 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1649 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1650 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1651 octave_idx_type off2 = (k - i - 1) * 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 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1654 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1655 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1656 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1657 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1658 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1659 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1660 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1661 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1662 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1663 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1664 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1665 } |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1668 else |
10314
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 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1671 ("eigs: error %d in dseupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1672 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1673 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1674 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1675 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1676 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1677 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1678 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1679 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1680 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1681 EigsRealNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1682 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1683 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1684 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1685 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1686 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1687 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1688 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1689 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1690 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1691 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1692 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1693 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1694 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1695 double sigmar = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1696 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1697 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1698 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1699 if (m.rows() != m.cols()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1700 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1701 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1702 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1703 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1704 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1705 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1706 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1707 ("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
|
1708 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1709 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1710 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1711 if (resid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1712 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1713 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1714 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1715 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1716 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1717 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1718 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1719 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1720 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1721 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1722 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1723 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1724 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1725 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1726 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1727 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1728 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1729 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1730 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1731 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1732 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1733 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1734 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1735 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1736 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1737 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1738 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1739 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1740 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1741 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1742 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1743 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1744 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1745 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1746 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1747 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1748 ("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
|
1749 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1750 } |
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 if (have_b && cholB && permB.length() != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1753 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1754 // Check the we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1755 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1756 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1757 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1758 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1759 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1760 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1761 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1762 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1763 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1764 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1765 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1766 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1767 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1768 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1769 bidx >= n || D_NINT (bidx) != bidx) |
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 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1772 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1773 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1774 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1775 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1776 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1777 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1778 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1779 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
|
1780 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1781 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1782 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1783 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1784 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1785 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1786 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1787 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1788 if (typ == "LA" || typ == "SA" || typ == "BE") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1789 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1790 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1791 ("eigs: invalid sigma value for unsymmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1792 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1793 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1794 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1795 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1796 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1797 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1798 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1799 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1800 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1801 bt = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1802 b = b.transpose(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1803 if (permB.length() == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1804 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1805 permB = ColumnVector(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1806 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1807 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1808 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1809 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1810 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1811 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1812 if (! make_cholb(b, bt, permB)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1813 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1814 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1815 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1816 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1817 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1818 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1819 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1820 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1821 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
|
1822 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1823 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1824 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1825 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1826 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1827 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1828 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
|
1829 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1830 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1831 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1832 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1833 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1834 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1835 // 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
|
1836 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1837 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
|
1838 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1839 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1840 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1841 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1842 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1843 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1844 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1845 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1846 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1847 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1848 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1849 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1850 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1851 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1852 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1853 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1854 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1855 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1856 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
|
1857 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1858 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1859 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1860 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1861 ("eigs: unrecoverable exception encountered in dnaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1862 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1863 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1864 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1865 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1866 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1867 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1868 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1869 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1870 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1871 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1872 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1873 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1874 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1875 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1876 // 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
|
1877 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1878 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1879 // 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
|
1880 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1881 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1882 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1883 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1884 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1885 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1886 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1887 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1888 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1889 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1890 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1891 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
|
1892 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1893 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1894 |
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 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1897 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1898 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
|
1899 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1900 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1901 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1902 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1903 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1904 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1905 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1906 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1907 ("eigs: error %d in dnaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1908 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1909 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1910 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1911 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1912 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1913 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1914 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1915 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1916 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1917 // 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
|
1918 // 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
|
1919 // 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
|
1920 // 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
|
1921 // 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
|
1922 // 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
|
1923 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1924 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
|
1925 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1926 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1927 Matrix eig_vec2 (n, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1928 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1929 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1930 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1931 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1932 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1933 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
|
1934 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1935 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1936 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1937 (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
|
1938 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1939 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
|
1940 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
|
1941 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1942 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1943 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1944 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1945 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1946 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1947 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1948 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1949 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1950 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1951 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1952 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1953 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1954 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1955 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1956 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1957 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
|
1958 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1959 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
|
1960 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1961 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1962 d [i-jj] = Complex (dr[i], di[i]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1963 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1964 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1965 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1966 d[i] = d[i+1]; |
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 k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1969 for (octave_idx_type i = 0; i < k2; 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 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1972 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1973 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1974 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1975 eig_val.resize(k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1976 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1977 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1978 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1979 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1980 |
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 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1984 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1985 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1986 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1987 continue; |
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 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1990 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1991 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1992 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1993 z[off1 + j] = z[off2 + j]; |
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 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1996 z[off2 + j] = dtmp[j]; |
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1999 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2000 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2001 while (i < k) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2002 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2003 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2004 octave_idx_type off2 = (i+1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2005 if (std::imag(eig_val(i)) == 0) |
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++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2008 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2009 Complex(z[j+off1],0.); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2010 i++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2011 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2012 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2013 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2014 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2015 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2016 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2017 Complex(z[j+off1],z[j+off2]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2018 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2019 eig_vec(j,i+1) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2020 Complex(z[j+off1],-z[j+off2]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2021 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2022 i+=2; |
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 } |
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 if (note3) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2027 eig_vec = ltsolve(M (b), permB, eig_vec); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2028 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2029 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2030 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2031 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2032 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2033 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2034 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2035 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2036 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2037 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2038 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2039 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2040 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2041 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2042 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2043 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2044 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
|
2045 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2046 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2047 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2048 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2049 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2050 bool cholB, int disp, int maxit) |
8417
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 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2053 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2054 octave_idx_type mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2055 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2056 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2057 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2058 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2059 if (m.rows() != m.cols()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2060 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2061 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2062 return -1; |
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 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2065 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2066 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2067 ("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
|
2068 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2069 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2070 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2071 // 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
|
2072 //if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2073 // 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
|
2074 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2075 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2076 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2077 if (resid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2078 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2079 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2080 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2081 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2082 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2083 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2084 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2085 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2086 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2087 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2088 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2089 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2090 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2091 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2092 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2093 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2094 p = k * 2 + 1; |
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 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2097 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2098 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2099 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2100 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2101 } |
9228
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 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2104 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2105 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2106 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2107 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2108 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2109 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2110 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2111 if (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2112 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2113 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2114 ("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
|
2115 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2116 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2117 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2118 if (have_b && cholB && permB.length() != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2119 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2120 // Check that we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2121 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2122 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2123 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2124 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2125 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2126 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2127 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2128 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2129 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2130 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2131 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2132 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2133 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2134 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2135 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2136 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2137 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2138 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2139 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2140 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2141 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2142 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2143 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2144 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2145 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2146 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2147 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2148 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
|
2149 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2150 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2151 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2152 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2153 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2154 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2155 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
|
2156 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2157 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2158 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2159 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2160 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2161 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2162 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2163 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2164 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
|
2165 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2166 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2167 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2168 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2169 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2170 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2171 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2172 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2173 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2174 if (! LuAminusSigmaB(m, b, cholB, permB, sigmar, L, U, P, Q)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2175 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2176 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2177 octave_idx_type lwork = 3 * p * (p + 2); |
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_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2180 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2181 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2182 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2183 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2184 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2185 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2186 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2187 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2188 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2189 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2190 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2191 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
|
2192 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2193 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2194 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2195 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2196 ("eigs: unrecoverable exception encountered in dsaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2197 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2198 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2199 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2200 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2201 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2202 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2203 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2204 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2205 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2206 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2207 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2208 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2209 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2210 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2211 // 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
|
2212 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2213 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2214 // 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
|
2215 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2216 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2217 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2218 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2219 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2220 if (ido == -1 || ido == 1 || ido == 2) |
10314
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 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2223 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2224 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2225 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2226 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2227 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2228 vector_product (m, workd+iptr(0)-1, dtmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2229 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2230 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2231 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2232 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2233 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2234 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2235 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2236 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2237 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2238 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2239 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2240 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2241 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2242 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
|
2243 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2244 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2245 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2246 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2247 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2248 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2249 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2250 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2251 lusolve (L, U, tmp); |
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 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2254 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2255 ip2[Q[i]] = tmp(i,0); |
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 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2258 else |
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 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2261 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2262 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2263 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
|
2264 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2265 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2266 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2267 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2268 Matrix tmp(n, 1); |
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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2271 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2272 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2273 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2274 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2275 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2276 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2277 ip2[Q[i]] = tmp(i,0); |
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 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2280 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2281 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2282 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2283 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2284 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2285 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2286 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2287 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2288 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2289 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2290 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2291 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2292 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2293 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2294 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2295 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2296 // 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
|
2297 // 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
|
2298 // 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
|
2299 // 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
|
2300 // 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
|
2301 // 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
|
2302 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2303 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
|
2304 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
|
2305 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2306 Matrix eig_vec2 (n, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2307 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2308 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2309 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2310 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2311 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2312 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
|
2313 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2314 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2315 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2316 (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
|
2317 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2318 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
|
2319 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
|
2320 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2321 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2322 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2323 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2324 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2325 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2326 return -1; |
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 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2329 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2330 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2331 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2332 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2333 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2334 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2335 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2336 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
|
2337 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2338 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
|
2339 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2340 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2341 d [i-jj] = Complex (dr[i], di[i]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2342 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2343 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2344 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2345 d[i] = d[i+1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2346 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2347 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2348 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2349 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2350 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2351 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2352 d[k - i - 1] = dtmp; |
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 eig_val.resize(k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2355 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2356 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2357 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2358 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2359 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2360 for (octave_idx_type i = 0; i < k2; i++) |
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 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2363 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2364 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2365 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2366 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2367 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2368 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2369 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2370 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2371 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2372 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2373 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2374 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2375 z[off2 + j] = dtmp[j]; |
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2378 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2379 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2380 while (i < k) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2381 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2382 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2383 octave_idx_type off2 = (i+1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2384 if (std::imag(eig_val(i)) == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2385 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2386 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
|
2387 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2388 Complex(z[j+off1],0.); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2389 i++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2390 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2391 else |
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 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2395 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2396 Complex(z[j+off1],z[j+off2]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2397 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2398 eig_vec(j,i+1) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2399 Complex(z[j+off1],-z[j+off2]); |
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 i+=2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2402 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2403 } |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2406 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2407 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2408 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2409 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2410 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2411 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2412 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2413 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2414 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2415 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2416 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2417 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2418 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2419 const std::string &_typ, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2420 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
|
2421 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2422 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
|
2423 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2424 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2425 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2426 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2427 bool have_sigma = (sigmar ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2428 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2429 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2430 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2431 int err = 0; |
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 if (resid.is_empty()) |
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 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2436 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2437 resid = ColumnVector (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2438 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2439 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2440 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2441 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2442 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2443 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2444 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2445 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2446 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2447 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2448 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2449 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2450 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2451 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2452 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2453 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2454 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2455 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2456 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2457 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2458 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2459 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2460 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2461 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2462 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2463 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2464 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2465 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2466 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2467 if (p <= k || p >= n) |
8417
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 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2470 ("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
|
2471 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2472 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2473 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2474 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2475 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2476 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2477 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
|
2478 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2479 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
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: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2482 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2483 if (typ == "LA" || typ == "SA" || typ == "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2484 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2485 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2486 ("eigs: invalid sigma value for unsymmetric problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2487 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2488 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2489 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2490 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2491 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2492 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2493 sigmar = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2494 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2495 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2496 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2497 else if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2498 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2499 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2500 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2501 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2502 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2503 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2504 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2505 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
|
2506 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2507 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2508 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2509 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2510 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2511 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2512 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
|
2513 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2514 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2515 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2516 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2517 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2518 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2519 // 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
|
2520 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2521 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
|
2522 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2523 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2524 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2525 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2526 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2527 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2528 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2529 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2530 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2531 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2532 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2533 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2534 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2535 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2536 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2537 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2538 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2539 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2540 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
|
2541 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2542 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2543 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2544 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2545 ("eigs: unrecoverable exception encountered in dnaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2546 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2547 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2548 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2549 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2550 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2551 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2552 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2553 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2554 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2555 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2556 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2557 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2558 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2559 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2560 // 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
|
2561 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2562 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2563 // 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
|
2564 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2565 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2566 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2567 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2568 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2569 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2570 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2571 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2572 ColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2573 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2574 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2575 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2576 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2577 ColumnVector y = fun (x, err); |
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 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2580 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2581 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2582 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2583 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2584 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2585 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2586 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2587 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2588 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2589 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2590 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2591 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2592 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2593 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2594 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2595 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2596 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2597 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2598 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2599 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2600 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2601 // 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
|
2602 // 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
|
2603 // 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
|
2604 // 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
|
2605 // 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
|
2606 // 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
|
2607 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2608 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
|
2609 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2610 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2611 Matrix eig_vec2 (n, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2612 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2613 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2614 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2615 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2616 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2617 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
|
2618 dr[i] = di[i] = 0.; |
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 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2621 (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
|
2622 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2623 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
|
2624 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
|
2625 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2626 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2627 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2628 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2629 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2630 ("eigs: unrecoverable exception encountered in dneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2631 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2632 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2633 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2634 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2635 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2636 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2637 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2638 if (info2 == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2639 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2640 octave_idx_type jj = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2641 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
|
2642 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2643 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
|
2644 jj++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2645 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2646 d [i-jj] = Complex (dr[i], di[i]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2647 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2648 if (jj == 0 && !rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2649 for (octave_idx_type i = 0; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2650 d[i] = d[i+1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2651 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2652 octave_idx_type k2 = k / 2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2653 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2654 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2655 Complex dtmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2656 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2657 d[k - i - 1] = dtmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2658 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2659 eig_val.resize(k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2660 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2661 if (rvec) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2662 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2663 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2664 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2665 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2666 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2667 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2668 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2669 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2670 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2671 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2672 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2673 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2674 dtmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2675 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2676 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2677 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2678 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2679 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2680 z[off2 + j] = dtmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2681 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2682 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2683 eig_vec.resize (n, k); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2684 octave_idx_type i = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2685 while (i < k) |
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 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2688 octave_idx_type off2 = (i+1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2689 if (std::imag(eig_val(i)) == 0) |
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 j = 0; j < n; j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2692 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2693 Complex(z[j+off1],0.); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2694 i++; |
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 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2697 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2698 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2699 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2700 eig_vec(j,i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2701 Complex(z[j+off1],z[j+off2]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2702 if (i < k - 1) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2703 eig_vec(j,i+1) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2704 Complex(z[j+off1],-z[j+off2]); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2705 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2706 i+=2; |
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 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2710 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2711 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2712 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2713 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2714 ("eigs: error %d in dneupd", info2); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2715 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2716 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2717 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2718 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2719 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2720 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2721 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2722 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2723 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2724 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2725 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2726 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2727 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2728 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2729 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2730 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2731 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2732 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2733 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2734 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2735 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2736 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2737 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2738 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2739 Complex sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2740 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2741 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2742 if (m.rows() != m.cols()) |
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 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2745 return -1; |
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 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2748 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2749 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2750 ("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
|
2751 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2752 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2753 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2754 if (cresid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2755 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2756 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2757 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2758 Array<double> rr (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2759 Array<double> ri (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2760 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2761 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
|
2762 cresid(i) = Complex(rr(i),ri(i)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2763 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2764 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2765 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2766 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2767 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2768 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2769 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2770 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2771 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2772 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2773 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2774 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2775 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2776 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2777 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2778 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2779 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2780 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2781 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2782 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2783 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2784 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2785 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2786 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2787 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2788 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2789 return -1; |
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 (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2793 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
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: 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
|
2796 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2797 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2798 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2799 if (have_b && cholB && permB.length() != 0) |
8417
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 // Check the we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2802 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2803 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2804 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2805 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2806 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2807 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2808 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2809 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2810 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2811 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2812 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2813 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2814 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2815 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2816 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2817 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2818 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2819 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2820 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2821 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2822 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2823 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2824 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2825 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2826 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
|
2827 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2828 typ != "SI") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
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: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2832 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2833 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2834 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2835 if (typ == "LA" || typ == "SA" || typ == "BE") |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2836 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2837 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2838 ("eigs: invalid sigma value for complex problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2839 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2840 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2841 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2842 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2843 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2844 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2845 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2846 if (cholB) |
10314
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 bt = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2849 b = b.hermitian(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2850 if (permB.length() == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2851 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2852 permB = ColumnVector(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2853 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2854 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2855 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2856 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2857 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2858 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2859 if (! make_cholb(b, bt, permB)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2860 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2861 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2862 ("eigs: The matrix B is not positive definite"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2863 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2864 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2865 } |
8417
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 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2868 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
|
2869 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2870 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2871 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2872 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2873 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2874 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2875 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
|
2876 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2877 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2878 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2879 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2880 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2881 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2882 // 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
|
2883 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2884 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
|
2885 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2886 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2887 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2888 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2889 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
|
2890 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2891 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2892 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2893 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2894 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2895 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2896 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2897 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2898 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2899 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2900 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2901 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2902 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2903 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2904 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
|
2905 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2906 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2907 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2908 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2909 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2910 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2911 } |
8417
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 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2914 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2915 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2916 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2917 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2918 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2919 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2920 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2921 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2922 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2923 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2924 // 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
|
2925 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2926 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2927 // 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
|
2928 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2929 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2930 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2931 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2932 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2933 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2934 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2935 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2936 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2937 ComplexMatrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2938 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2939 mtmp(i,0) = workd[i + iptr(0) - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2940 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2941 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2942 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2943 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2944 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2945 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
|
2946 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2947 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2948 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2949 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2950 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2951 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2952 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2953 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2954 ("eigs: error %d in znaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2955 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2956 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2957 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2958 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2959 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2960 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2961 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2962 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2963 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2964 // 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
|
2965 // 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
|
2966 // 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
|
2967 // 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
|
2968 // 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
|
2969 // 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
|
2970 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2971 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
|
2972 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2973 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2974 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2975 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2976 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2977 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2978 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2979 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2980 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2981 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2982 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2983 (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
|
2984 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2985 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2986 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
|
2987 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
|
2988 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2989 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2990 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2991 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2992 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2993 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2994 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2995 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2996 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2997 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2998 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2999 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
|
3000 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3001 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3002 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3003 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3004 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3005 eig_val.resize(k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3006 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3007 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3008 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3009 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3010 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3011 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3012 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3013 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3014 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3015 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3016 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3017 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3018 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3019 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3020 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3021 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3022 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3023 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3024 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3025 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3026 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3027 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3028 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3029 if (note3) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3030 eig_vec = ltsolve(b, permB, eig_vec); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3031 } |
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 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3034 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3035 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3036 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3037 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3038 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3039 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3040 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3041 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3042 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3043 template <class M> |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3044 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3045 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3046 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
|
3047 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3048 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3049 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3050 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3051 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3052 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3053 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3054 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3055 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3056 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3057 octave_idx_type mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3058 bool have_b = ! b.is_empty(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3059 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3060 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3061 if (m.rows() != m.cols()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3062 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3063 (*current_liboctave_error_handler) ("eigs: A must be square"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3064 return -1; |
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 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3067 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3068 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3069 ("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
|
3070 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3071 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3072 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3073 // 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
|
3074 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3075 // 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
|
3076 // eig_val, _b, permB, cresid, os, tol, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3077 // rvec, cholB, disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3078 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3079 if (cresid.is_empty()) |
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 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3082 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3083 Array<double> rr (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3084 Array<double> ri (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3085 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3086 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
|
3087 cresid(i) = Complex(rr(i),ri(i)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3088 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3089 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3090 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3091 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3092 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3093 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3094 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3095 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3096 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3097 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3098 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3099 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3100 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3101 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3102 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3103 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3104 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3105 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3106 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3107 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3108 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3109 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3110 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3111 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3112 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3113 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3114 return -1; |
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 (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3118 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
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: 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
|
3121 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3122 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3123 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3124 if (have_b && cholB && permB.length() != 0) |
8417
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 // Check that we really have a permutation vector |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3127 if (permB.length() != n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3128 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3129 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3130 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3131 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3132 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3133 { |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3134 Array<bool> checked (dim_vector (n, 1), false); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3135 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3136 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3137 octave_idx_type bidx = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3138 static_cast<octave_idx_type> (permB(i)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3139 if (checked(bidx) || bidx < 0 || |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3140 bidx >= n || D_NINT (bidx) != bidx) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3141 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3142 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3143 ("eigs: permB vector invalid"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3144 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3145 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3146 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3147 } |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3150 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3151 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3152 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3153 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3154 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
|
3155 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3156 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3157 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3158 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3159 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3160 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3161 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
|
3162 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3163 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3164 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3165 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3166 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3167 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3168 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3169 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3170 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
|
3171 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3172 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3173 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3174 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3175 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3176 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3177 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3178 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols())); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3179 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3180 if (! LuAminusSigmaB(m, b, cholB, permB, sigma, L, U, P, Q)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3181 return -1; |
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 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
|
3184 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3185 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3186 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3187 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3188 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3189 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3190 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3191 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3192 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3193 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3194 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3195 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3196 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3197 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3198 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
|
3199 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3200 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3201 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3202 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3203 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3204 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3205 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3206 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3207 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3208 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3209 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3210 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3211 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3212 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3213 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3214 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3215 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3216 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3217 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3218 // 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
|
3219 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3220 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3221 // 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
|
3222 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3223 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3224 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3225 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3226 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3227 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3228 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3229 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3230 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3231 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3232 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3233 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
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 vector_product (m, workd+iptr(0)-1, ctmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3236 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3237 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3238 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3239 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3240 tmp(i,0) = ctmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3241 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3242 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3243 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3244 Complex *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3245 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3246 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3247 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3248 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3249 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
|
3250 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3251 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3252 Complex *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3253 ComplexMatrix tmp(n, 1); |
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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3256 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3257 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3258 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3259 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3260 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3261 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3262 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3263 } |
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 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3266 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3267 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3268 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3269 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3270 workd[iptr(0) + i - 1] = |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3271 workd[iptr(1) + i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3272 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3273 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3274 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3275 Complex *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3276 ComplexMatrix tmp(n, 1); |
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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3279 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3280 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3281 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3282 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3283 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3284 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3285 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3286 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3287 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3288 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3289 else |
10314
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 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3292 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3293 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3294 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3295 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3296 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3297 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3298 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3299 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3300 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3301 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3302 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3303 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3304 // 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
|
3305 // 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
|
3306 // 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
|
3307 // 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
|
3308 // 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
|
3309 // 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
|
3310 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3311 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
|
3312 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3313 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3314 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3315 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3316 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3317 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3318 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3319 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3320 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3321 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3322 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3323 (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
|
3324 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3325 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3326 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
|
3327 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
|
3328 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3329 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3330 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3331 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3332 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3333 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3334 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3335 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3336 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3337 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3338 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3339 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
|
3340 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3341 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3342 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3343 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3344 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3345 eig_val.resize(k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3346 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3347 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3348 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3349 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3350 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3351 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3352 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3353 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3354 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3355 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3356 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3357 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3358 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3359 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3360 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3361 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3362 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3363 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3364 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3365 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3366 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3367 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3368 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3369 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3370 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3371 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3372 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3373 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3374 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3375 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3376 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3377 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3378 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3379 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3380 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3381 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3382 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3383 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
|
3384 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3385 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3386 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
|
3387 double tol, bool rvec, bool /* cholB */, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3388 int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3389 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3390 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3391 bool have_sigma = (std::abs(sigma) ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3392 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3393 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3394 int err = 0; |
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 if (cresid.is_empty()) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3397 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3398 std::string rand_dist = octave_rand::distribution(); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3399 octave_rand::distribution("uniform"); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3400 Array<double> rr (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3401 Array<double> ri (octave_rand::vector(n)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3402 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3403 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
|
3404 cresid(i) = Complex(rr(i),ri(i)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3405 octave_rand::distribution(rand_dist); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3406 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3407 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3408 if (n < 3) |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3409 { |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3410 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3411 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3412 return -1; |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3413 } |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3414 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3415 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3416 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3417 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3418 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3419 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3420 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3421 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3422 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3423 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3424 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3425 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3426 if (k <= 0 || k >= n - 1) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3427 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3428 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3429 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3430 " Use 'eig(full(A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3431 return -1; |
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 (p <= k || p >= n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3435 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
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: 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
|
3438 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3439 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3440 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3441 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3442 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3443 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
|
3444 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3445 typ != "SI") |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3446 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3447 ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3448 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3449 if (typ == "LA" || typ == "SA" || typ == "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3450 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3451 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3452 ("eigs: invalid sigma value for complex problem"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3453 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3454 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3455 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3456 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3457 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3458 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3459 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3460 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3461 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3462 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3463 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3464 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3465 else |
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 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3468 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3469 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3470 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3471 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
|
3472 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3473 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3474 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3475 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3476 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3477 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3478 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
|
3479 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3480 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3481 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3482 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3483 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3484 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3485 // 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
|
3486 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3487 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
|
3488 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3489 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3490 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3491 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3492 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
|
3493 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3494 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3495 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3496 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3497 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3498 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3499 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3500 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3501 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3502 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3503 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3504 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3505 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3506 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3507 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
|
3508 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3509 if (f77_exception_encountered) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3510 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3511 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3512 ("eigs: unrecoverable exception encountered in znaupd"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3513 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3514 } |
8417
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 if (disp > 0 && !xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3517 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3518 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3519 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3520 os << "Iteration " << iter - 1 << |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3521 ": a few Ritz values of the " << p << "-by-" << |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3522 p << " matrix\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3523 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3524 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3525 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3526 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3527 // 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
|
3528 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3529 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3530 // 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
|
3531 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3532 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3533 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3534 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3535 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3536 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3537 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3538 Complex *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3539 ComplexColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3540 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3541 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3542 x(i) = *ip2++; |
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 ComplexColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3545 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3546 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3547 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3548 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3549 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3550 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3551 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3552 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3553 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3554 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3555 if (info < 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3556 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3557 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3558 ("eigs: error %d in dsaupd", info); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3559 return -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3560 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3561 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3562 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3563 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3564 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3565 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3566 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3567 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3568 // 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
|
3569 // 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
|
3570 // 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
|
3571 // 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
|
3572 // 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
|
3573 // 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
|
3574 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3575 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
|
3576 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3577 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3578 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3579 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3580 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3581 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3582 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3583 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3584 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3585 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3586 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3587 (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
|
3588 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3589 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3590 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
|
3591 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
|
3592 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3593 if (f77_exception_encountered) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3594 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3595 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3596 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3597 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3598 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3599 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3600 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3601 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3602 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3603 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
|
3604 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3605 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3606 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3607 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3608 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3609 eig_val.resize(k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3610 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3611 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3612 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3613 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3614 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3615 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3616 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3617 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3618 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3619 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3620 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3621 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3622 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3623 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3624 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3625 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3626 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3627 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3628 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3629 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3630 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3631 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3632 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3633 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3634 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3635 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3636 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3637 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3638 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3639 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3640 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3641 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3642 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3643 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3644 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3645 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3646 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3647 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3648 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3649 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3650 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3651 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3652 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
|
3653 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3654 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3655 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3656 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3657 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3658 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3659 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3660 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3661 std::ostream& os, double tol = DBL_EPSILON, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3662 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
|
3663 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3664 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3665 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3666 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3667 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
|
3668 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3669 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3670 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3671 std::ostream &os, double tol = DBL_EPSILON, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3672 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
|
3673 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3674 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3675 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3676 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3677 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
|
3678 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3679 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3680 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3681 std::ostream &os, double tol = DBL_EPSILON, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3682 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
|
3683 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3684 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3685 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3686 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3687 const std::string &typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3688 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3689 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3690 Matrix &eig_vec, ColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3691 ColumnVector &resid, std::ostream &os, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3692 double tol = DBL_EPSILON, bool rvec = false, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3693 bool cholB = 0, int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3694 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3695 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3696 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3697 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3698 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3699 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3700 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3701 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3702 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
|
3703 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3704 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3705 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3706 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3707 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3708 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
|
3709 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3710 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3711 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3712 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3713 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
|
3714 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3715 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3716 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3717 EigsRealNonSymmetricMatrixShift (const Matrix& m, 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 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3721 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3722 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3723 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3724 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
|
3725 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3726 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3727 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3728 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3729 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3730 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3731 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3732 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3733 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3734 ColumnVector &permB, ColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3735 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3736 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
|
3737 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3738 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3739 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3740 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3741 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3742 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
|
3743 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3744 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3745 ColumnVector &resid, std::ostream& os, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3746 double tol = DBL_EPSILON, bool rvec = false, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3747 bool cholB = 0, int disp = 0, 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 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3750 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3751 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3752 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
|
3753 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3754 const ComplexMatrix& b, ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3755 ComplexColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3756 std::ostream &os, double tol = DBL_EPSILON, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3757 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
|
3758 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3759 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3760 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3761 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3762 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
|
3763 octave_idx_type p, octave_idx_type &info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3764 ComplexMatrix &eig_vec, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3765 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3766 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3767 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3768 ComplexColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3769 std::ostream &os, double tol = DBL_EPSILON, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3770 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
|
3771 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3772 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3773 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3774 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3775 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
|
3776 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3777 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3778 ComplexColumnVector &eig_val, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3779 const ComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3780 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3781 ComplexColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3782 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3783 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3784 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3785 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3786 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3787 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3788 Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3789 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
|
3790 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3791 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3792 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3793 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3794 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3795 ComplexColumnVector &resid, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3796 std::ostream &os, double tol = DBL_EPSILON, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3797 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3798 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3799 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3800 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3801 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3802 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3803 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
|
3804 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3805 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3806 ComplexColumnVector &resid, std::ostream& os, |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3807 double tol = DBL_EPSILON, bool rvec = false, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3808 bool cholB = 0, int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3809 #endif |
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 #ifndef _MSC_VER |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3812 template static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3813 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3814 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3815 template static octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3816 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3817 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3818 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3819 template static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3820 lusolve (const Matrix&, const Matrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3821 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3822 template static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3823 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
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 template static ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3826 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3827 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3828 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3829 template static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3830 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3831 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3832 template static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3833 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3834 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3835 template static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3836 ltsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3837 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3838 template static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3839 utsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3840 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3841 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3842 template static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3843 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3844 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3845 template static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3846 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3847 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3848 template static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3849 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3850 #endif |
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 #endif |