Mercurial > jwe > octave
annotate liboctave/numeric/eigs-base.cc @ 21139:538b57866b90
consistently use "typename" intead of "class" in template declarations
* Object.h, QtHandlesUtils.cc, QtHandlesUtils.h, ToolBarButton.cc,
ToolBarButton.h, Cell.h, __lin_interpn__.cc, bitfcns.cc, bsxfun.cc,
cellfun.cc, data.cc, filter.cc, gcd.cc, graphics.cc, help.cc, kron.cc,
lookup.cc, ls-mat5.cc, ls-oct-text.h, lu.cc, max.cc, mgorth.cc,
oct-map.cc, oct-map.h, oct-stream.cc, oct-stream.h, octave-link.h,
pr-output.cc, profiler.h, schur.cc, sparse-xdiv.cc, sparse-xpow.cc,
sqrtm.cc, symtab.h, tril.cc, typecast.cc, variables.cc, xdiv.cc,
zfstream.h, __init_fltk__.cc, __magick_read__.cc, chol.cc, qr.cc,
ov-base-diag.cc, ov-base-diag.h, ov-base-int.cc, ov-base-int.h,
ov-base-mat.cc, ov-base-mat.h, ov-base-scalar.cc, ov-base-scalar.h,
ov-base-sparse.cc, ov-base-sparse.h, ov-base.h, ov-classdef.cc,
ov-int-traits.h, ov-java.h, ov-usr-fcn.h, ov.cc, ov.h,
op-dms-template.cc, oct-parse.in.yy, parse.h, pt-mat.cc, Array-b.cc,
Array.cc, Array.h, CDiagMatrix.h, CMatrix.h, CNDArray.h,
DiagArray2.cc, DiagArray2.h, MArray.cc, MArray.h, MDiagArray2.cc,
MDiagArray2.h, MSparse.cc, MSparse.h, MatrixType.cc, Sparse.cc,
Sparse.h, dDiagMatrix.h, dMatrix.h, dNDArray.h, fCDiagMatrix.h,
fCMatrix.h, fCNDArray.h, fDiagMatrix.h, fMatrix.h, fNDArray.h,
idx-vector.cc, idx-vector.h, intNDArray.cc, intNDArray.h, DET.h,
base-aepbal.h, base-lu.cc, base-lu.h, base-qr.cc, base-qr.h,
bsxfun-defs.cc, eigs-base.cc, lo-mappers.h, lo-specfun.cc,
lo-specfun.h, oct-convn.cc, oct-fftw.cc, oct-norm.cc,
sparse-base-chol.cc, sparse-base-chol.h, sparse-base-lu.cc,
sparse-base-lu.h, sparse-dmsolve.cc, mx-inlines.cc,
action-container.h, base-list.h, lo-traits.h, lo-utils.h,
oct-base64.h, oct-binmap.h, oct-cmplx.h, oct-inttypes.cc,
oct-inttypes.h, oct-locbuf.h, oct-refcount.h, oct-sort.cc, oct-sort.h:
Use "typename" instead of "class" in template declarations.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Sun, 24 Jan 2016 13:50:04 -0500 |
parents | 7cac4e7458f2 |
children | 307096fb67e1 |
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 |
19697
4197fc428c7d
maint: Update copyright notices for 2015.
John W. Eaton <jwe@octave.org>
parents:
19410
diff
changeset
|
3 Copyright (C) 2005-2015 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" |
19269
65554f5847ac
don't include oct-locbuf.h in header files unnecessarily
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
33 #include "oct-locbuf.h" |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
34 #include "quit.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
35 #include "SparsedbleLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
36 #include "SparseCmplxLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
37 #include "dSparse.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
38 #include "CSparse.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
39 #include "MatrixType.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
40 #include "SparsedbleCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
41 #include "SparseCmplxCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
42 #include "oct-rand.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
43 #include "dbleCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
44 #include "CmplxCHOL.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
45 #include "dbleLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
46 #include "CmplxLU.h" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
47 |
14144
834df9f10963
remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
48 #ifdef HAVE_ARPACK |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
49 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
|
50 typedef ComplexColumnVector (*EigsComplexFunc) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
51 (const ComplexColumnVector &x, int &eigs_error); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
52 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
53 // Arpack and blas fortran functions we call. |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
54 extern "C" |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
55 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
56 F77_RET_T |
11518 | 57 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&, |
58 F77_CONST_CHAR_ARG_DECL, | |
59 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
60 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
61 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
62 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
63 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
|
64 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
65 const octave_idx_type&, octave_idx_type& |
11518 | 66 F77_CHAR_ARG_LEN_DECL |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
67 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
68 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
69 F77_RET_T |
11518 | 70 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&, |
71 F77_CONST_CHAR_ARG_DECL, | |
72 octave_idx_type*, double*, double*, | |
73 const octave_idx_type&, const double&, | |
74 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
75 const octave_idx_type&, |
11518 | 76 F77_CONST_CHAR_ARG_DECL, |
77 const octave_idx_type&, const double&, double*, | |
78 const octave_idx_type&, double*, | |
79 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
|
80 octave_idx_type*, double*, double*, |
11518 | 81 const octave_idx_type&, octave_idx_type& |
82 F77_CHAR_ARG_LEN_DECL | |
83 F77_CHAR_ARG_LEN_DECL | |
84 F77_CHAR_ARG_LEN_DECL); | |
85 | |
86 F77_RET_T | |
87 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&, | |
88 F77_CONST_CHAR_ARG_DECL, | |
89 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
90 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
91 octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
92 double*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
93 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
|
94 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
95 const octave_idx_type&, octave_idx_type& |
11518 | 96 F77_CHAR_ARG_LEN_DECL |
97 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
98 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
99 F77_RET_T |
11518 | 100 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&, |
101 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
102 octave_idx_type*, double*, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
103 double*, const octave_idx_type&, const double&, |
11518 | 104 const double&, double*, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
105 F77_CONST_CHAR_ARG_DECL, |
11518 | 106 const octave_idx_type&, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
107 F77_CONST_CHAR_ARG_DECL, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
108 octave_idx_type&, const double&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
109 const octave_idx_type&, double*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
110 const octave_idx_type&, octave_idx_type*, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
111 octave_idx_type*, double*, double*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
112 const octave_idx_type&, octave_idx_type& |
11518 | 113 F77_CHAR_ARG_LEN_DECL |
114 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
115 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
116 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
117 F77_RET_T |
11518 | 118 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&, |
119 F77_CONST_CHAR_ARG_DECL, | |
120 const octave_idx_type&, | |
121 F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
122 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
123 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
124 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
|
125 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
126 const octave_idx_type&, double *, octave_idx_type& |
11518 | 127 F77_CHAR_ARG_LEN_DECL |
128 F77_CHAR_ARG_LEN_DECL); | |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
129 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
130 F77_RET_T |
11518 | 131 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&, |
132 F77_CONST_CHAR_ARG_DECL, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
133 octave_idx_type*, Complex*, Complex*, |
11518 | 134 const octave_idx_type&, const Complex&, Complex*, |
135 F77_CONST_CHAR_ARG_DECL, | |
136 const octave_idx_type&, | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
137 F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
138 const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
139 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
140 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
|
141 octave_idx_type*, Complex*, Complex*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
142 const octave_idx_type&, double *, octave_idx_type& |
11518 | 143 F77_CHAR_ARG_LEN_DECL |
144 F77_CHAR_ARG_LEN_DECL | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
145 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
146 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
147 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
148 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, |
11518 | 149 const octave_idx_type&, const octave_idx_type&, |
150 const double&, const double*, | |
151 const octave_idx_type&, const double*, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
152 const octave_idx_type&, const double&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
153 const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
154 F77_CHAR_ARG_LEN_DECL); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
155 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
156 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
157 F77_RET_T |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
158 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
159 const octave_idx_type&, const octave_idx_type&, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
160 const Complex&, const Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
161 const octave_idx_type&, const Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
162 const octave_idx_type&, const Complex&, Complex*, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
163 const octave_idx_type& |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
164 F77_CHAR_ARG_LEN_DECL); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
165 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
166 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
167 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
168 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20232
diff
changeset
|
169 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
170 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
171 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
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 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
174 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
175 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
176 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
177 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
178 lusolve (const Matrix&, const Matrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
179 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
180 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
181 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
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 ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
184 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
185 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
186 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
187 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
188 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
189 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
190 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
191 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
192 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
193 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
194 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
195 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
196 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
197 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
198 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
199 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
200 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
201 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
202 static ComplexMatrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
203 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
204 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
205 static Matrix |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
206 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
207 |
12202
dc72a664ac7a
eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents:
12198
diff
changeset
|
208 #endif |
dc72a664ac7a
eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents:
12198
diff
changeset
|
209 |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
210 static void |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
211 warn_convergence (void) |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
212 { |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
213 (*current_liboctave_warning_with_id_handler) |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
214 ("Octave:convergence", |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
215 "eigs: 'A - sigma*B' is singular, indicating sigma is exactly " |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
216 "an eigenvalue so convergence is not guaranteed"); |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
217 } |
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
218 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
219 template <typename M, typename SM> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
220 static octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
221 lusolve (const SM& L, const SM& U, M& m) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
222 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
223 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
224 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
225 MatrixType utyp (MatrixType::Upper); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
226 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
227 // 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
|
228 m = L.solve (m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
229 if (err) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
230 return err; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
231 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
232 m = U.solve (utyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
233 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
234 return err; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
235 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
236 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
237 template <typename SM, typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
238 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
239 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
|
240 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
241 octave_idx_type n = L.cols (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
242 octave_idx_type b_nc = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
243 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
244 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
245 MatrixType ltyp (MatrixType::Lower); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
246 M tmp = L.solve (ltyp, m, err, rcond, 0); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
247 M retval; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
248 const double* qv = Q.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
249 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
250 if (! err) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
251 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
252 retval.resize (n, b_nc); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
253 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
|
254 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
255 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
256 retval.elem (static_cast<octave_idx_type>(qv[i]), j) = |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
257 tmp.elem (i,j); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
258 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
259 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
260 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
261 return retval; |
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 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
264 template <typename SM, typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
265 static M |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
266 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
|
267 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
268 octave_idx_type n = U.cols (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
269 octave_idx_type b_nc = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
270 octave_idx_type err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
271 double rcond; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
272 MatrixType utyp (MatrixType::Upper); |
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 M retval (n, b_nc); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
275 const double* qv = Q.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
276 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
|
277 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
278 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
279 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
|
280 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
281 return U.solve (utyp, retval, err, rcond, 0); |
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 SparseMatrix& 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 nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
288 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
289 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
290 y[j] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
291 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
292 for (octave_idx_type j = 0; j < nc; j++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
293 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
294 y[m.ridx (i)] += m.data (i) * x[j]; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
295 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
296 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
297 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
298 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
299 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
300 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
|
301 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
302 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
303 octave_idx_type nc = m.cols (); |
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 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
|
306 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
307 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
308 F77_CHAR_ARG_LEN (1))); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
309 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
310 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
311 (*current_liboctave_error_handler) ("eigs: unrecoverable error in dgemv"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
312 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
313 return true; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
314 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
315 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
316 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
317 vector_product (const SparseComplexMatrix& m, const Complex* x, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
318 Complex* y) |
8417
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 octave_idx_type nc = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
321 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
322 for (octave_idx_type j = 0; j < nc; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
323 y[j] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
324 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
325 for (octave_idx_type j = 0; j < nc; j++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
326 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
327 y[m.ridx (i)] += m.data (i) * x[j]; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
328 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
329 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
330 } |
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 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
333 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
|
334 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
335 octave_idx_type nr = m.rows (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
336 octave_idx_type nc = m.cols (); |
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 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
|
339 nr, nc, 1.0, m.data (), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
340 x, 1, 0.0, y, 1 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
341 F77_CHAR_ARG_LEN (1))); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
342 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
343 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
344 (*current_liboctave_error_handler) ("eigs: unrecoverable error in zgemv"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
345 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
346 return true; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
347 } |
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 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
350 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
351 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
352 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
353 CHOL fact (b, info); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
354 octave_idx_type n = b.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
355 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
356 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
357 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
358 else |
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 bt = fact.chol_matrix (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
361 b = bt.transpose (); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
362 permB = ColumnVector (n); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
363 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
|
364 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
365 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
366 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
367 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
368 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
369 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
370 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB) |
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 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
373 SparseCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
374 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
375 if (fact.P () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
376 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
377 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
378 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
379 b = fact.L (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
380 bt = b.transpose (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
381 permB = fact.perm () - 1.0; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
382 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
383 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
384 } |
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 static bool |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
387 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
388 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
389 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
390 ComplexCHOL fact (b, info); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
391 octave_idx_type n = b.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
392 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
393 if (info != 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
394 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
395 else |
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 bt = fact.chol_matrix (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
398 b = bt.hermitian (); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
399 permB = ColumnVector (n); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
400 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
|
401 permB(i) = i; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
402 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
403 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
404 } |
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 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
407 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
408 ColumnVector& permB) |
8417
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 octave_idx_type info; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
411 SparseComplexCHOL fact (b, info, false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
412 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
413 if (fact.P () != 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
414 return false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
415 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
416 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
417 b = fact.L (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
418 bt = b.hermitian (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
419 permB = fact.perm () - 1.0; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
420 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
421 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
422 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
423 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
424 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
425 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
426 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
|
427 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
428 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
429 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
430 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
431 octave_idx_type n = m.rows (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
432 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
433 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
434 SparseMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
435 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
436 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
437 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
438 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
439 { |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
440 if (permB.numel ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
441 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
442 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
443 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
444 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
445 tmp.xcidx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
446 tmp.xridx (i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
447 static_cast<octave_idx_type>(permB(i)); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
448 tmp.xdata (i) = 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
449 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
450 tmp.xcidx (n) = n; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
451 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
452 AminusSigmaB -= sigma * tmp * |
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
453 b.transpose () * b * tmp.transpose (); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
454 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
455 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
456 AminusSigmaB -= sigma * b.transpose () * b; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
457 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
458 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
459 AminusSigmaB -= sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
460 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
461 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
462 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
463 SparseMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
464 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
465 // Create sigma * speye (n,n) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
466 sigmat.xcidx (0) = 0; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
467 for (octave_idx_type i = 0; i < n; i++) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
468 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
469 sigmat.xdata (i) = sigma; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
470 sigmat.xridx (i) = i; |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
471 sigmat.xcidx (i+1) = i + 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
472 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
473 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
474 AminusSigmaB -= sigmat; |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
475 } |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
476 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
477 SparseLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
478 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
479 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
480 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
481 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
482 const octave_idx_type *Q2 = fact.col_perm (); |
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 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
485 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
486 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
487 Q[j] = Q2[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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
490 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
491 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
492 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
493 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
494 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
495 double d = 0.; |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
496 if (U.xcidx (j+1) > U.xcidx (j) |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
497 && U.xridx (U.xcidx (j+1)-1) == j) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
498 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
|
499 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
500 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
501 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
502 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
503 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
504 maxU = d; |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
507 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
508 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
509 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
510 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
511 warn_convergence (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
512 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
513 return true; |
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
516 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
517 LuAminusSigmaB (const Matrix &m, const Matrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
518 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
|
519 Matrix &L, Matrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
520 octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
521 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
522 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
523 octave_idx_type n = m.cols (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
524 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
525 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
526 Matrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
527 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
528 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
529 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
530 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
531 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
532 Matrix tmp = sigma * b.transpose () * b; |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
533 const double *pB = permB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
534 double *p = AminusSigmaB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
535 |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
536 if (permB.numel ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
537 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
538 for (octave_idx_type j = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
539 j < b.cols (); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
540 for (octave_idx_type i = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
541 i < b.rows (); i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
542 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
543 static_cast<octave_idx_type>(pB[j])); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
544 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
545 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
546 AminusSigmaB -= tmp; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
547 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
548 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
549 AminusSigmaB -= sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
550 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
551 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
552 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
553 double *p = AminusSigmaB.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
554 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
555 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
|
556 p[i*(n+1)] -= sigma; |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
559 LU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
560 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
561 L = fact.P ().transpose () * fact.L (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
562 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
563 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
|
564 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
565 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
566 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
567 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
568 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
569 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
570 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
571 double d = std::abs (U.xelem (j,j)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
572 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
573 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
574 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
575 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
576 maxU = d; |
8417
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 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
579 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
580 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
581 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
582 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
583 warn_convergence (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
584 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
585 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
586 } |
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 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
589 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
590 bool cholB, const ColumnVector& permB, Complex sigma, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
591 SparseComplexMatrix &L, SparseComplexMatrix &U, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
592 octave_idx_type *P, octave_idx_type *Q) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
593 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
594 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
595 octave_idx_type n = m.rows (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
596 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
597 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
598 SparseComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
599 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
600 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
601 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
602 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
603 { |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
604 if (permB.numel ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
605 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
606 SparseMatrix tmp(n,n,n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
607 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
608 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
609 tmp.xcidx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
610 tmp.xridx (i) = |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
611 static_cast<octave_idx_type>(permB(i)); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
612 tmp.xdata (i) = 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
613 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
614 tmp.xcidx (n) = n; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
615 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
616 AminusSigmaB -= tmp * b.hermitian () * b * |
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
617 tmp.transpose () * sigma; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
618 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
619 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
620 AminusSigmaB -= sigma * b.hermitian () * b; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
621 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
622 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
623 AminusSigmaB -= sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
624 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
625 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
626 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
627 SparseComplexMatrix sigmat (n, n, n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
628 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
629 // Create sigma * speye (n,n) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
630 sigmat.xcidx (0) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
631 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
|
632 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
633 sigmat.xdata (i) = sigma; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
634 sigmat.xridx (i) = i; |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
635 sigmat.xcidx (i+1) = i + 1; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
636 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
637 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
638 AminusSigmaB -= sigmat; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
639 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
640 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
641 SparseComplexLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
642 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
643 L = fact.L (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
644 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
645 const octave_idx_type *P2 = fact.row_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
646 const octave_idx_type *Q2 = fact.col_perm (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
647 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
648 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
649 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
650 P[j] = P2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
651 Q[j] = Q2[j]; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
652 } |
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 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
655 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
656 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
657 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
658 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
659 double d = 0.; |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
660 if (U.xcidx (j+1) > U.xcidx (j) |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
661 && U.xridx (U.xcidx (j+1)-1) == j) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
662 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
|
663 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
664 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
665 minU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
666 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
667 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
668 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
669 } |
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 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
672 volatile double rcond_plus_one = rcond + 1.0; |
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 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
675 warn_convergence (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
676 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
677 return true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
678 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
679 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
680 static bool |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
681 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
682 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
|
683 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
684 octave_idx_type *Q) |
8417
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 bool have_b = ! b.is_empty (); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
687 octave_idx_type n = m.cols (); |
8417
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 // Caclulate LU decomposition of 'A - sigma * B' |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
690 ComplexMatrix AminusSigmaB (m); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
691 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
692 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
693 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
694 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
695 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
696 ComplexMatrix tmp = sigma * b.hermitian () * b; |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
697 const double *pB = permB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
698 Complex *p = AminusSigmaB.fortran_vec (); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
699 |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
700 if (permB.numel ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
701 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
702 for (octave_idx_type j = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
703 j < b.cols (); j++) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
704 for (octave_idx_type i = 0; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
705 i < b.rows (); i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
706 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
707 static_cast<octave_idx_type>(pB[j])); |
10314
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 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
710 AminusSigmaB -= tmp; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
711 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
712 else |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
19864
diff
changeset
|
713 AminusSigmaB -= sigma * b; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
714 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
715 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
716 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
717 Complex *p = AminusSigmaB.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
718 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
719 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
|
720 p[i*(n+1)] -= sigma; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
721 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
722 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
723 ComplexLU fact (AminusSigmaB); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
724 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
725 L = fact.P ().transpose () * fact.L (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
726 U = fact.U (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
727 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
|
728 P[j] = Q[j] = j; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
729 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
730 // Test condition number of LU decomposition |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
731 double minU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
732 double maxU = octave_NaN; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
733 for (octave_idx_type j = 0; j < n; j++) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
734 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
735 double d = std::abs (U.xelem (j,j)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
736 if (xisnan (minU) || d < minU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
737 minU = d; |
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 if (xisnan (maxU) || d > maxU) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
740 maxU = d; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
741 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
742 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
743 double rcond = (minU / maxU); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
744 volatile double rcond_plus_one = rcond + 1.0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
745 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
746 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19269
diff
changeset
|
747 warn_convergence (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
748 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
749 return true; |
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 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
752 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
753 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
754 EigsRealSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
755 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
756 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
757 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
758 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
759 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
760 bool cholB, int disp, int maxit) |
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 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
763 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
764 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
765 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
766 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
767 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
768 double sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
769 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
770 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
771 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
772 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
773 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
774 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
775 ("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
|
776 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
777 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
778 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
779 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
780 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
781 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
782 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
783 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
784 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
785 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
786 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
787 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
788 if (p < 0) |
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 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
791 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
792 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
793 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
794 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
795 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
796 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
797 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
798 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
799 if (k < 1 || k > n - 2) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
800 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
801 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
802 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
803 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
804 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
805 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
806 ("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
|
807 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
808 if (have_b && cholB && ! permB.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
809 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
810 // Check the we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
811 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
812 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
813 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
814 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
815 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
|
816 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
817 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
818 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
819 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
820 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
821 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
822 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
823 |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
824 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
825 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
826 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
827 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
828 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
829 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
830 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
831 ("eigs: invalid sigma value for real symmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
832 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
833 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
834 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
835 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
836 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
837 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
838 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
839 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
840 b = b.transpose (); |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
841 if (permB.is_empty ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
842 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
843 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
844 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
845 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
846 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
847 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
848 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
849 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
850 if (! make_cholb (b, bt, permB)) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
851 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
852 ("eigs: The matrix B is not positive definite"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
853 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
854 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
855 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
856 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
|
857 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
858 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
859 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
860 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
861 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
862 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
863 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
|
864 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
865 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
866 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
867 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
868 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
869 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
870 // 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
|
871 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
872 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
|
873 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
874 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
875 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
876 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
877 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
878 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
879 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
880 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
881 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
882 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
883 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
884 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
885 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
886 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
887 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
888 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
889 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
890 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
891 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
|
892 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
893 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
894 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
895 ("eigs: unrecoverable exception encountered in dsaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
896 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
897 if (disp > 0 && ! xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
898 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
899 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
900 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
901 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
902 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
903 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
904 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
905 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
906 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
907 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
908 // 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
|
909 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
910 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
911 // 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
|
912 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
913 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
914 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
915 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
916 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
917 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
918 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
919 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
920 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
921 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
922 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
923 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
|
924 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
925 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
926 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
927 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
928 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
929 } |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
930 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
|
931 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
932 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
933 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
934 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
935 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
936 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
937 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
938 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
939 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
940 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
941 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
942 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
943 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
944 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
945 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
946 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
947 // 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
|
948 // 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
|
949 // 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
|
950 // 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
|
951 // 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
|
952 // 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
|
953 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
954 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
|
955 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
|
956 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
957 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
958 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
959 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
960 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
961 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
962 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
963 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
964 (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
|
965 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
966 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
|
967 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
|
968 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
969 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
970 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
971 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
972 ("eigs: unrecoverable exception encountered in dseupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
973 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
974 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
975 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
976 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
977 if (typ != "SM" && typ != "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
978 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
979 for (octave_idx_type i = 0; i < k2; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
980 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
981 double dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
982 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
983 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
984 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
985 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
986 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
987 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
988 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
989 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
990 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
991 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
992 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
993 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
994 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
995 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
996 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
997 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
998 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
999 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1000 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1001 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1002 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1003 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1004 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1005 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1006 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1007 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1008 z[off2 + j] = dtmp[j]; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1009 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1010 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1011 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1012 if (note3) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1013 eig_vec = ltsolve (b, permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1014 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1015 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1016 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1017 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1018 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1019 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1020 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1021 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
1022 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1023 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1024 EigsRealSymmetricMatrixShift (const M& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1025 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
|
1026 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1027 ColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1028 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1029 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1030 bool cholB, int disp, int maxit) |
8417
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 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1033 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1034 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1035 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1036 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1037 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1038 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1039 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1040 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1041 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1042 ("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
|
1043 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1044 // 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
|
1045 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1046 // 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
|
1047 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1048 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1049 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1050 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1051 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1052 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1053 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1054 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1055 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1056 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1057 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1058 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1059 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1060 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1061 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1062 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1063 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1064 " Use 'eig (full (A))' instead"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1065 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1066 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1067 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1068 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1069 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1070 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1071 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1072 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1073 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1074 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1075 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1076 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1077 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1078 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1079 ("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
|
1080 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
1081 if (have_b && cholB && ! permB.is_empty ()) |
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 // Check the we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1084 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1085 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1086 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1087 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1088 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
|
1089 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1090 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1091 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1092 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1093 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1094 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1095 } |
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 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1098 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1099 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1100 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1101 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
|
1102 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1103 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1104 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1105 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1106 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1107 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1108 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
|
1109 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1110 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1111 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1112 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1113 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1114 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1115 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1116 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1117 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
|
1118 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1119 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1120 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1121 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1122 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1123 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1124 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1125 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1126 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1127 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1128 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1129 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1130 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1131 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1132 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1133 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1134 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1135 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1136 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1137 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1138 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1139 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1140 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1141 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1142 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1143 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1144 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
|
1145 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1146 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1147 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1148 ("eigs: unrecoverable exception encountered in dsaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1149 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
1150 if (disp > 0 && ! xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1151 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1152 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1153 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1154 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1155 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1156 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1157 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1158 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1159 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1160 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1161 // 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
|
1162 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1163 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1164 // 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
|
1165 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1166 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1167 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1168 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1169 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1170 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1171 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1172 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1173 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1174 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1175 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1176 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1177 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1178 vector_product (m, workd+iptr(0)-1, dtmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1179 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1180 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1181 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1182 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1183 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1184 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1185 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1186 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1187 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1188 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1189 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1190 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1191 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1192 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
|
1193 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1194 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1195 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1196 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1197 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1198 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1199 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1200 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1201 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1202 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1203 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1204 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1205 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1206 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1207 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1208 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1209 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1210 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1211 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1212 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1213 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
|
1214 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1215 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1216 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1217 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1218 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1219 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1220 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1221 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1222 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1223 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1224 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1225 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1226 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1227 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1228 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1229 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1230 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1231 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1232 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1233 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1234 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1235 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1236 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1237 break; |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1240 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1241 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1242 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1243 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1244 // 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
|
1245 // 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
|
1246 // 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
|
1247 // 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
|
1248 // 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
|
1249 // 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
|
1250 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1251 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
|
1252 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
|
1253 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1254 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1255 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1256 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1257 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1258 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1259 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1260 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1261 (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
|
1262 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1263 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1264 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
|
1265 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
|
1266 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1267 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1268 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1269 ("eigs: unrecoverable exception encountered in dseupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1270 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1271 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1272 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1273 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1274 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
|
1275 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1276 double dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1277 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1278 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1279 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1280 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1281 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1282 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1283 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1284 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1285 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1286 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1287 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1288 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1289 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1290 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1291 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1292 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1293 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1294 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1295 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1296 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1297 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1298 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1299 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1300 z[off2 + j] = dtmp[j]; |
10314
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1303 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1304 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1305 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1306 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1307 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1308 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1309 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1310 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1311 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1312 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1313 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
|
1314 octave_idx_type &info, Matrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1315 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
|
1316 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1317 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1318 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1319 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1320 bool have_sigma = (sigma ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1321 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1322 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1323 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1324 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1325 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1326 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1327 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1328 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1329 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1330 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1331 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1332 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1333 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1334 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1335 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1336 if (p < 0) |
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 p = k * 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1339 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1340 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1341 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1342 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1343 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1344 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1345 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1346 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1347 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1348 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1349 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1350 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1351 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1352 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1353 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1354 ("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
|
1355 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1356 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1357 { |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1358 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1359 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1360 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1361 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
8417
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 (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1364 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1365 ("eigs: invalid sigma value for real symmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1366 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1367 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1368 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1369 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1370 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1371 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1372 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1373 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1374 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1375 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1376 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1377 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1378 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1379 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1380 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1381 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1382 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
|
1383 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1384 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1385 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1386 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1387 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1388 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1389 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
|
1390 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1391 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1392 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1393 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1394 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1395 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1396 // 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
|
1397 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1398 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
|
1399 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1400 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1401 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1402 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1403 octave_idx_type lwork = p * (p + 8); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1404 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1405 OCTAVE_LOCAL_BUFFER (double, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1406 OCTAVE_LOCAL_BUFFER (double, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1407 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1408 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1409 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1410 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1411 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1412 F77_FUNC (dsaupd, DSAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1413 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1414 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1415 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1416 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1417 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
|
1418 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1419 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1420 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1421 ("eigs: unrecoverable exception encountered in dsaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1422 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
1423 if (disp > 0 && ! xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1424 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1425 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1426 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1427 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1428 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1429 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1430 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1431 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1432 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1433 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1434 // 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
|
1435 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1436 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1437 // 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
|
1438 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1439 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1440 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1441 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1442 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1443 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1444 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1445 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1446 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1447 ColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1448 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1449 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1450 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1451 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1452 ColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1453 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1454 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1455 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1456 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1457 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1458 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1459 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1460 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1461 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1462 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1463 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1464 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1465 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1466 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1467 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1468 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1469 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1470 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1471 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1472 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1473 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1474 // 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
|
1475 // 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
|
1476 // 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
|
1477 // 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
|
1478 // 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
|
1479 // 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
|
1480 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1481 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
|
1482 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
|
1483 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1484 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1485 double *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1486 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1487 eig_val.resize (k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1488 double *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1489 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1490 F77_FUNC (dseupd, DSEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1491 (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
|
1492 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1493 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1494 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
|
1495 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
|
1496 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1497 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1498 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1499 ("eigs: unrecoverable exception encountered in dseupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1500 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1501 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1502 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1503 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1504 if (typ != "SM" && typ != "BE") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1505 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1506 for (octave_idx_type i = 0; i < k2; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1507 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1508 double dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1509 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1510 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1511 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1512 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1513 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1514 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1515 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1516 if (typ != "SM" && typ != "BE") |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1517 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1518 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1519 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1520 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1521 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1522 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1523 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1524 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1525 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1526 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1527 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1528 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1529 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1530 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1531 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1532 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1533 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1534 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1535 z[off2 + j] = dtmp[j]; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1536 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1537 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1538 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1539 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1540 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1541 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1542 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1543 return ip(4); |
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 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
1546 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1547 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1548 EigsRealNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1549 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1550 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1551 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1552 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1553 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1554 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1555 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1556 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1557 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1558 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1559 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1560 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1561 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1562 double sigmar = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1563 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1564 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1565 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1566 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1567 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1568 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1569 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1570 ("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
|
1571 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1572 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1573 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1574 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1575 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1576 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1577 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1578 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1579 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1580 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1581 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1582 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1583 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1584 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1585 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1586 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1587 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1588 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1589 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1590 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1591 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1592 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1593 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1594 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1595 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1596 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1597 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1598 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1599 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1600 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1601 ("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
|
1602 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
1603 if (have_b && cholB && ! permB.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1604 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1605 // Check the we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1606 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1607 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1608 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1609 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1610 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
|
1611 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1612 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1613 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1614 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1615 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1616 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1617 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1618 |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1619 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1620 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
1621 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1622 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1623 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1624 if (typ == "LA" || typ == "SA" || typ == "BE") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1625 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1626 ("eigs: invalid sigma value for unsymmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1627 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1628 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1629 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1630 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1631 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1632 if (cholB) |
10314
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 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1635 b = b.transpose (); |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
1636 if (permB.is_empty ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1637 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1638 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1639 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1640 permB(i) = i; |
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 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1643 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1644 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1645 if (! make_cholb (b, bt, permB)) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1646 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1647 ("eigs: The matrix B is not positive definite"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1648 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1649 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1650 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1651 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
|
1652 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1653 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1654 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1655 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1656 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1657 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1658 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
|
1659 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1660 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1661 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1662 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1663 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1664 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1665 // 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
|
1666 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1667 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
|
1668 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1669 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1670 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1671 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1672 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1673 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1674 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1675 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1676 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1677 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1678 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1679 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1680 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1681 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1682 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1683 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1684 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1685 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1686 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
|
1687 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1688 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1689 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1690 ("eigs: unrecoverable exception encountered in dnaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1691 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
1692 if (disp > 0 && ! xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1693 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1694 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1695 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1696 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1697 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1698 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1699 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1700 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1701 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1702 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1703 // 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
|
1704 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1705 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1706 // 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
|
1707 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1708 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1709 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1710 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1711 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1712 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1713 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1714 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1715 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1716 Matrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1717 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1718 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
|
1719 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1720 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1721 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1722 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1723 workd[i+iptr(1)-1] = mtmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1724 } |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
1725 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
|
1726 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1727 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1728 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1729 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1730 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1731 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1732 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1733 ("eigs: error %d in dnaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1734 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1735 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1736 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1737 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1738 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1739 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1740 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1741 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1742 // 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
|
1743 // 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
|
1744 // 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
|
1745 // 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
|
1746 // 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
|
1747 // 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
|
1748 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1749 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
|
1750 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1751 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1752 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1753 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1754 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1755 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1756 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1757 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1758 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
1759 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1760 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1761 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1762 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1763 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1764 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1765 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
|
1766 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1767 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1768 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1769 (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
|
1770 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1771 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
|
1772 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
|
1773 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1774 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1775 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1776 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1777 ("eigs: unrecoverable exception encountered in dneupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1778 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1779 eig_val.resize (k+1); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1780 Complex *d = eig_val.fortran_vec (); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1781 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1782 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1783 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1784 octave_idx_type jj = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1785 for (octave_idx_type i = 0; i < k+1; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1786 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1787 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1788 jj++; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1789 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1790 d[i-jj] = Complex (dr[i], di[i]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1791 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1792 if (jj == 0 && ! rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1793 for (octave_idx_type i = 0; i < k; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1794 d[i] = d[i+1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1795 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1796 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1797 for (octave_idx_type i = 0; i < k2; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1798 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1799 Complex dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1800 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1801 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1802 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1803 eig_val.resize (k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1804 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1805 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1806 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1807 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1808 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1809 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1810 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1811 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1812 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1813 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1814 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1815 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1816 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1817 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1818 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1819 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1820 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1821 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1822 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1823 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1824 z[off2 + j] = dtmp[j]; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1825 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1826 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1827 eig_vec.resize (n, k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1828 octave_idx_type i = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1829 while (i < k) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1830 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1831 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1832 octave_idx_type off2 = (i+1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1833 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1834 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1835 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1836 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1837 Complex (z[j+off1],0.); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1838 i++; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1839 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1840 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1841 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1842 for (octave_idx_type j = 0; j < n; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1843 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1844 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1845 Complex (z[j+off1],z[j+off2]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1846 if (i < k - 1) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1847 eig_vec(j,i+1) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1848 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1849 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1850 i+=2; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1851 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1852 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1853 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1854 if (note3) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1855 eig_vec = ltsolve (M(b), permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1856 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1857 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1858 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1859 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1860 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1861 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1862 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1863 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
1864 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1865 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1866 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1867 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
|
1868 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1869 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1870 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1871 ColumnVector &permB, ColumnVector &resid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1872 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1873 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1874 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1875 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1876 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1877 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1878 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1879 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1880 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1881 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1882 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1883 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1884 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1885 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1886 ("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
|
1887 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1888 // 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
|
1889 //if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1890 // 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
|
1891 // _b, permB, resid, os, tol, rvec, cholB, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1892 // disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1893 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1894 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1895 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1896 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1897 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1898 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1899 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1900 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1901 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1902 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1903 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1904 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1905 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1906 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1907 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1908 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1909 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1910 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1911 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1912 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1913 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1914 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1915 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1916 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1917 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1918 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1919 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1920 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1921 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1922 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1923 ("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
|
1924 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
1925 if (have_b && cholB && ! permB.is_empty ()) |
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 // Check that we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1928 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1929 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1930 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1931 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1932 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
|
1933 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1934 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1935 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1936 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1937 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1938 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1939 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1940 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1941 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1942 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1943 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1944 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1945 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
|
1946 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1947 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1948 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1949 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1950 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1951 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1952 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
|
1953 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1954 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1955 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1956 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1957 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1958 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1959 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1960 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1961 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
|
1962 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1963 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1964 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1965 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1966 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1967 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1968 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1969 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1970 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
1971 if (! LuAminusSigmaB (m, b, cholB, permB, sigmar, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1972 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1973 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1974 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1975 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1976 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1977 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1978 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1979 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1980 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1981 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1982 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1983 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1984 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
1985 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1986 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1987 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1988 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
|
1989 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1990 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1991 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
1992 ("eigs: unrecoverable exception encountered in dsaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1993 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
1994 if (disp > 0 && ! xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1995 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1996 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
1997 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
1998 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1999 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2000 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2001 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2002 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2003 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2004 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2005 // 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
|
2006 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2007 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2008 // 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
|
2009 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2010 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2011 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2012 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2013 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2014 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2015 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2016 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2017 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2018 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2019 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2020 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
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 vector_product (m, workd+iptr(0)-1, dtmp); |
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 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2025 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2026 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2027 tmp(i,0) = dtmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2028 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2029 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2030 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2031 double *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2032 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2033 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2034 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2035 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2036 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
|
2037 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2038 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2039 double *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2040 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2041 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2042 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2043 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2044 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2045 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2046 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2047 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2048 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2049 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2050 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2051 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2052 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2053 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2054 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2055 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2056 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2057 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
|
2058 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2059 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2060 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2061 double *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2062 Matrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2063 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2064 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2065 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2066 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2067 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2068 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2069 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2070 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2071 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2072 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2073 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2074 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2075 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2076 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2077 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2078 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2079 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2080 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2081 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2082 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2083 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2084 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2085 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2086 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2087 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2088 // 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
|
2089 // 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
|
2090 // 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
|
2091 // 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
|
2092 // 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
|
2093 // 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
|
2094 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2095 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
|
2096 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
|
2097 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2098 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2099 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2100 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2101 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2102 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2103 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2104 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2105 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2106 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2107 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2108 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2109 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2110 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2111 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
|
2112 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2113 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2114 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2115 (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
|
2116 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2117 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
|
2118 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
|
2119 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2120 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2121 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2122 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2123 ("eigs: unrecoverable exception encountered in dneupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2124 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2125 eig_val.resize (k+1); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2126 Complex *d = eig_val.fortran_vec (); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2127 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2128 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2129 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2130 octave_idx_type jj = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2131 for (octave_idx_type i = 0; i < k+1; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2132 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2133 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2134 jj++; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2135 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2136 d[i-jj] = Complex (dr[i], di[i]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2137 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2138 if (jj == 0 && ! rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2139 for (octave_idx_type i = 0; i < k; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2140 d[i] = d[i+1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2141 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2142 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2143 for (octave_idx_type i = 0; i < k2; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2144 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2145 Complex dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2146 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2147 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2148 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2149 eig_val.resize (k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2150 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2151 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2152 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2153 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2154 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2155 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2156 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2157 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2158 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2159 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2160 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2161 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2162 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2163 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2164 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2165 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2166 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2167 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2168 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2169 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2170 z[off2 + j] = dtmp[j]; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2171 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2172 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2173 eig_vec.resize (n, k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2174 octave_idx_type i = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2175 while (i < k) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2176 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2177 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2178 octave_idx_type off2 = (i+1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2179 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2180 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2181 for (octave_idx_type j = 0; j < n; j++) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2182 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2183 Complex (z[j+off1],0.); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2184 i++; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2185 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2186 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2187 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2188 for (octave_idx_type j = 0; j < n; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2189 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2190 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2191 Complex (z[j+off1],z[j+off2]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2192 if (i < k - 1) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2193 eig_vec(j,i+1) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2194 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2195 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2196 i+=2; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2197 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2198 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2199 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2200 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2201 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2202 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2203 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2204 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2205 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2206 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2207 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2208 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2209 const std::string &_typ, double sigmar, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2210 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
|
2211 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2212 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
|
2213 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2214 bool /* cholB */, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2215 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2216 std::string typ (_typ); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2217 bool have_sigma = (sigmar ? true : false); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2218 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2219 double sigmai = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2220 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2221 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2222 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2223 if (resid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2224 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2225 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2226 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2227 resid = ColumnVector (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2228 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2229 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2230 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2231 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2232 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2233 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2234 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2235 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2236 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2237 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2238 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2239 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2240 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2241 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2242 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2243 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2244 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2245 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2246 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2247 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2248 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2249 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2250 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2251 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2252 ("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
|
2253 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2254 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2255 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2256 { |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2257 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2258 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2259 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2260 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2261 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2262 if (typ == "LA" || typ == "SA" || typ == "BE") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2263 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2264 ("eigs: invalid sigma value for unsymmetric problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2265 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2266 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2267 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2268 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2269 sigmar = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2270 mode = 3; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2271 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2272 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2273 else if (! std::abs (sigmar)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2274 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2275 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2276 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2277 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2278 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2279 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2280 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2281 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
|
2282 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2283 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2284 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2285 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2286 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2287 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2288 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
|
2289 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2290 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2291 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2292 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2293 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2294 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2295 // 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
|
2296 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2297 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
|
2298 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2299 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2300 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2301 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2302 octave_idx_type lwork = 3 * p * (p + 2); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2303 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2304 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2305 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2306 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2307 double *presid = resid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2308 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2309 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2310 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2311 F77_FUNC (dnaupd, DNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2312 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2313 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2314 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2315 ipntr, workd, workl, lwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2316 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
|
2317 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2318 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2319 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2320 ("eigs: unrecoverable exception encountered in dnaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2321 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
2322 if (disp > 0 && ! xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2323 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2324 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2325 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2326 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2327 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2328 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2329 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2330 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2331 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2332 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2333 // 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
|
2334 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2335 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2336 // 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
|
2337 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2338 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2339 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2340 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2341 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2342 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2343 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2344 double *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2345 ColumnVector x(n); |
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 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2348 x(i) = *ip2++; |
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 ColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2351 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2352 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2353 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2354 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2355 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2356 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2357 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2358 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2359 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2360 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2361 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2362 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2363 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2364 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2365 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2366 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2367 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2368 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2369 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2370 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2371 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2372 // 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
|
2373 // 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
|
2374 // 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
|
2375 // 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
|
2376 // 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
|
2377 // 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
|
2378 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2379 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
|
2380 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2381 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2382 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip |
12198
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2383 // the assignment to elements of Z that represent imaginary parts. |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2384 // Found with valgrind and |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2385 // |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2386 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1]; |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2387 // [vecs, vals, f] = eigs (A, 1) |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2388 |
30ca5a0b0e2f
don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents:
12195
diff
changeset
|
2389 Matrix eig_vec2 (n, k + 1, 0.0); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2390 double *z = eig_vec2.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2391 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2392 OCTAVE_LOCAL_BUFFER (double, dr, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2393 OCTAVE_LOCAL_BUFFER (double, di, k + 1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2394 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2395 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
|
2396 dr[i] = di[i] = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2397 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2398 F77_FUNC (dneupd, DNEUPD) |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2399 (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
|
2400 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2401 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
|
2402 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
|
2403 F77_CHAR_ARG_LEN(2)); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2404 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2405 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2406 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2407 ("eigs: unrecoverable exception encountered in dneupd"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2408 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2409 eig_val.resize (k+1); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2410 Complex *d = eig_val.fortran_vec (); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2411 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2412 if (info2 == 0) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2413 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2414 octave_idx_type jj = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2415 for (octave_idx_type i = 0; i < k+1; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2416 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2417 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2418 jj++; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2419 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2420 d[i-jj] = Complex (dr[i], di[i]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2421 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2422 if (jj == 0 && ! rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2423 for (octave_idx_type i = 0; i < k; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2424 d[i] = d[i+1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2425 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2426 octave_idx_type k2 = k / 2; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2427 for (octave_idx_type i = 0; i < k2; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2428 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2429 Complex dtmp = d[i]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2430 d[i] = d[k - i - 1]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2431 d[k - i - 1] = dtmp; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2432 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2433 eig_val.resize (k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2434 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2435 if (rvec) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2436 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2437 OCTAVE_LOCAL_BUFFER (double, dtmp, n); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2438 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2439 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2440 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2441 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2442 octave_idx_type off2 = (k - i - 1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2443 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2444 if (off1 == off2) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2445 continue; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2446 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2447 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2448 dtmp[j] = z[off1 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2449 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2450 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2451 z[off1 + j] = z[off2 + j]; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2452 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2453 for (octave_idx_type j = 0; j < n; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2454 z[off2 + j] = dtmp[j]; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2455 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2456 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2457 eig_vec.resize (n, k); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2458 octave_idx_type i = 0; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2459 while (i < k) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2460 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2461 octave_idx_type off1 = i * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2462 octave_idx_type off2 = (i+1) * n; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2463 if (std::imag (eig_val(i)) == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2464 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2465 for (octave_idx_type j = 0; j < n; j++) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2466 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2467 Complex (z[j+off1],0.); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2468 i++; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2469 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2470 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2471 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2472 for (octave_idx_type j = 0; j < n; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2473 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2474 eig_vec(j,i) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2475 Complex (z[j+off1],z[j+off2]); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2476 if (i < k - 1) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2477 eig_vec(j,i+1) = |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2478 Complex (z[j+off1],-z[j+off2]); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2479 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2480 i+=2; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2481 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2482 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2483 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2484 } |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2485 else |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2486 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2487 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2488 return ip(4); |
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 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
2491 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2492 octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2493 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2494 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2495 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2496 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2497 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2498 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2499 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2500 bool cholB, int disp, int maxit) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2501 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2502 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2503 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2504 octave_idx_type mode = 1; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2505 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2506 bool note3 = false; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2507 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2508 Complex sigma = 0.; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2509 M bt; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2510 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2511 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2512 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2513 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2514 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2515 ("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
|
2516 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2517 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2518 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2519 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2520 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2521 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2522 Array<double> ri (octave_rand::vector (n)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2523 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2524 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2525 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2526 octave_rand::distribution (rand_dist); |
8417
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 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2529 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2530 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2531 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2532 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2533 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2534 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2535 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2536 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2537 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2538 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2539 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2540 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2541 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2542 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2543 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2544 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2545 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2546 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2547 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2548 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2549 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2550 ("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
|
2551 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
2552 if (have_b && cholB && ! permB.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2553 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2554 // Check the we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
2555 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2556 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2557 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2558 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2559 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
|
2560 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2561 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2562 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2563 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2564 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2565 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2566 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2567 |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2568 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2569 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
2570 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2571 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2572 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2573 if (typ == "LA" || typ == "SA" || typ == "BE") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2574 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2575 ("eigs: invalid sigma value for complex problem"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2576 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2577 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2578 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2579 // See Note 3 dsaupd |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2580 note3 = true; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2581 if (cholB) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2582 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2583 bt = b; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2584 b = b.hermitian (); |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
2585 if (permB.is_empty ()) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2586 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2587 permB = ColumnVector (n); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2588 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2589 permB(i) = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2590 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2591 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2592 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2593 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2594 if (! make_cholb (b, bt, permB)) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2595 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2596 ("eigs: The matrix B is not positive definite"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2597 } |
8417
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 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2600 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
|
2601 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2602 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2603 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2604 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2605 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2606 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2607 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
|
2608 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2609 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2610 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2611 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2612 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2613 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2614 // 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
|
2615 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2616 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
|
2617 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2618 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2619 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2620 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2621 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
|
2622 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2623 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2624 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2625 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2626 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2627 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2628 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2629 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2630 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2631 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2632 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2633 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2634 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2635 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2636 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
|
2637 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2638 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2639 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2640 ("eigs: unrecoverable exception encountered in znaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2641 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
2642 if (disp > 0 && ! xisnan (workl[iptr (5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2643 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2644 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2645 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2646 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2647 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2648 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2649 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2650 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2651 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2652 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2653 // 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
|
2654 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2655 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2656 // 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
|
2657 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2658 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2659 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2660 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2661 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2662 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2663 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2664 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2665 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2666 ComplexMatrix mtmp (n,1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2667 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2668 mtmp(i,0) = workd[i + iptr(0) - 1]; |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2669 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2670 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2671 workd[i+iptr(1)-1] = mtmp(i,0); |
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 } |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
2674 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
|
2675 workd + iptr(1) - 1)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2676 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2677 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2678 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2679 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2680 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2681 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2682 ("eigs: error %d in znaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2683 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2684 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2685 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2686 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2687 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2688 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2689 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2690 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2691 // 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
|
2692 // 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
|
2693 // 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
|
2694 // 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
|
2695 // 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
|
2696 // 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
|
2697 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2698 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
|
2699 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2700 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2701 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2702 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2703 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2704 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2705 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2706 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2707 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2708 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2709 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2710 (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
|
2711 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2712 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2713 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
|
2714 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
|
2715 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2716 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2717 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2718 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2719 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2720 if (info2 == 0) |
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 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2723 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
|
2724 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2725 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2726 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2727 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2728 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2729 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2730 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2731 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2732 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2733 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2734 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2735 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2736 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2737 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2738 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2739 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2740 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2741 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2742 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2743 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2744 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2745 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2746 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2747 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2748 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2749 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2750 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2751 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2752 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2753 if (note3) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2754 eig_vec = ltsolve (b, permB, eig_vec); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2755 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2756 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2757 else |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2758 (*current_liboctave_error_handler) ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2759 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2760 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2761 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2762 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
2763 template <typename M> |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2764 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2765 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2766 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
|
2767 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2768 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2769 ComplexColumnVector &eig_val, const M& _b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2770 ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2771 ComplexColumnVector &cresid, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2772 std::ostream& os, double tol, bool rvec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2773 bool cholB, int disp, int maxit) |
8417
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 M b(_b); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2776 octave_idx_type n = m.cols (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2777 octave_idx_type mode = 3; |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2778 bool have_b = ! b.is_empty (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2779 std::string typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2780 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2781 if (m.rows () != m.cols ()) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2782 (*current_liboctave_error_handler) ("eigs: A must be square"); |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2783 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ())) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2784 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2785 ("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
|
2786 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2787 // 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
|
2788 //if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2789 // 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
|
2790 // eig_val, _b, permB, cresid, os, tol, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2791 // rvec, cholB, disp, maxit); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2792 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2793 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2794 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2795 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2796 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2797 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2798 Array<double> ri (octave_rand::vector (n)); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2799 cresid = ComplexColumnVector (n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2800 for (octave_idx_type i = 0; i < n; i++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2801 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2802 octave_rand::distribution (rand_dist); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2803 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2804 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2805 if (n < 3) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2806 (*current_liboctave_error_handler) ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2807 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2808 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2809 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2810 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2811 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2812 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2813 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2814 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2815 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2816 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2817 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2818 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2819 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2820 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2821 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2822 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2823 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2824 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2825 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2826 ("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
|
2827 |
20974
1edf15793cac
maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents:
20955
diff
changeset
|
2828 if (have_b && cholB && ! permB.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2829 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2830 // Check that we really have a permutation vector |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
2831 if (permB.numel () != n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2832 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2833 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2834 Array<bool> checked (dim_vector (n, 1), false); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2835 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
|
2836 { |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2837 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2838 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2839 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2840 (*current_liboctave_error_handler) ("eigs: permB vector invalid"); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2841 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2842 } |
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 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2845 if (have_b) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2846 bmat = 'G'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2847 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2848 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
|
2849 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2850 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2851 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2852 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2853 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2854 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2855 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
|
2856 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2857 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2858 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2859 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2860 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2861 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2862 // ip(7) to ip(10) return values |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2863 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2864 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
|
2865 octave_idx_type *ipntr = iptr.fortran_vec (); |
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 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2868 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2869 M L, U; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2870 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2871 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ())); |
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2872 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ())); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2873 |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
2874 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q)) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2875 return -1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2876 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2877 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
|
2878 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2879 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2880 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2881 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2882 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2883 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2884 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2885 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2886 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2887 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2888 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
2889 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2890 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2891 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2892 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
|
2893 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2894 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2895 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2896 ("eigs: unrecoverable exception encountered in znaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2897 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
2898 if (disp > 0 && ! xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2899 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2900 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2901 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2902 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2903 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2904 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2905 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2906 os << " " << workl[iptr(5)+i-1] << "\n"; |
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 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2909 // 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
|
2910 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2911 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2912 // 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
|
2913 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2914 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2915 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2916 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2917 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2918 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2919 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2920 if (have_b) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2921 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2922 if (ido == -1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2923 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2924 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2925 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2926 vector_product (m, workd+iptr(0)-1, ctmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2927 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2928 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2929 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2930 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2931 tmp(i,0) = ctmp[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2932 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2933 lusolve (L, U, tmp); |
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 Complex *ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2936 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2937 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2938 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2939 else if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2940 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
|
2941 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2942 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2943 Complex *ip2 = workd+iptr(2)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2944 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2945 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2946 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2947 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2948 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2949 lusolve (L, U, tmp); |
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 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2952 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2953 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2954 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2955 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2956 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2957 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2958 if (ido == 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2959 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2960 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2961 workd[iptr(0) + i - 1] = |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2962 workd[iptr(1) + i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2963 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2964 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2965 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2966 Complex *ip2 = workd+iptr(0)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2967 ComplexMatrix tmp(n, 1); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2968 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2969 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2970 tmp(i,0) = ip2[P[i]]; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2971 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2972 lusolve (L, U, tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2973 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2974 ip2 = workd+iptr(1)-1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2975 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2976 ip2[Q[i]] = tmp(i,0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2977 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2978 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2979 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2980 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2981 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2982 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2983 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2984 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
2985 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2986 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
2987 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2988 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2989 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2990 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2991 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2992 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
2993 // 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
|
2994 // 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
|
2995 // 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
|
2996 // 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
|
2997 // 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
|
2998 // 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
|
2999 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3000 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
|
3001 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3002 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3003 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3004 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3005 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3006 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3007 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3008 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3009 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3010 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3011 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3012 (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
|
3013 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3014 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3015 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
|
3016 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
|
3017 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3018 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3019 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3020 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3021 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3022 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3023 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3024 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3025 for (octave_idx_type i = 0; i < k2; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3026 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3027 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3028 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3029 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3030 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3031 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3032 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3033 if (rvec) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3034 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3035 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3036 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3037 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3038 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3039 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3040 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3041 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3042 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3043 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3044 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3045 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3046 ctmp[j] = z[off1 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3047 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3048 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3049 z[off1 + j] = z[off2 + j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3050 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3051 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3052 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3053 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3054 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3055 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3056 else |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3057 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3058 ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3059 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3060 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3061 } |
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 octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3064 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3065 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3066 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
|
3067 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3068 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3069 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
|
3070 double tol, bool rvec, bool /* cholB */, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3071 int disp, int maxit) |
8417
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 std::string typ (_typ); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3074 bool have_sigma = (std::abs (sigma) ? true : false); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3075 char bmat = 'I'; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3076 octave_idx_type mode = 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3077 int err = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3078 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3079 if (cresid.is_empty ()) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3080 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3081 std::string rand_dist = octave_rand::distribution (); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3082 octave_rand::distribution ("uniform"); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3083 Array<double> rr (octave_rand::vector (n)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3084 Array<double> ri (octave_rand::vector (n)); |
8417
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++) |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3087 cresid(i) = Complex (rr(i),ri(i)); |
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3088 octave_rand::distribution (rand_dist); |
8417
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) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3092 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3093 ("eigs: n must be at least 3"); |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3094 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3095 if (p < 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3096 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3097 p = k * 2 + 1; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3098 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3099 if (p < 20) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3100 p = 20; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3101 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3102 if (p > n - 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3103 p = n - 1 ; |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3104 } |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3105 |
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3106 if (k <= 0 || k >= n - 1) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3107 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3108 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3109 " Use 'eig (full (A))' instead"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3110 |
9228
ab40ef1e232f
fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
3111 if (p <= k || p >= n) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3112 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3113 ("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
|
3114 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3115 if (! have_sigma) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3116 { |
19864
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
3117 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
3118 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" |
17d647821d61
maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
3119 && typ != "SI") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3120 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3121 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3122 if (typ == "LA" || typ == "SA" || typ == "BE") |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3123 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3124 ("eigs: invalid sigma value for complex problem"); |
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 if (typ == "SM") |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3127 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3128 typ = "LM"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3129 sigma = 0.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3130 mode = 3; |
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 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3133 else if (! std::abs (sigma)) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3134 typ = "SM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3135 else |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3136 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3137 typ = "LM"; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3138 mode = 3; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3139 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3140 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3141 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
|
3142 octave_idx_type *iparam = ip.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3143 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3144 ip(0) = 1; //ishift |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3145 ip(1) = 0; // ip(1) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3146 ip(2) = maxit; // mxiter, maximum number of iterations |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3147 ip(3) = 1; // NB blocksize in recurrence |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3148 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
|
3149 ip(5) = 0; //ip(5) not referenced |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3150 ip(6) = mode; // mode |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3151 ip(7) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3152 ip(8) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3153 ip(9) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3154 ip(10) = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3155 // 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
|
3156 |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3157 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
|
3158 octave_idx_type *ipntr = iptr.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3159 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3160 octave_idx_type ido = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3161 int iter = 0; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3162 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
|
3163 |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3164 OCTAVE_LOCAL_BUFFER (Complex, v, n * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3165 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3166 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3167 OCTAVE_LOCAL_BUFFER (double, rwork, p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3168 Complex *presid = cresid.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3169 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3170 do |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3171 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3172 F77_FUNC (znaupd, ZNAUPD) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3173 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14711
diff
changeset
|
3174 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3175 k, tol, presid, p, v, n, iparam, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3176 ipntr, workd, workl, lwork, rwork, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3177 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
|
3178 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3179 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3180 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3181 ("eigs: unrecoverable exception encountered in znaupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3182 |
20955
77f5591878bf
maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
3183 if (disp > 0 && ! xisnan(workl[iptr(5)-1])) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3184 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3185 if (iter++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3186 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3187 os << "Iteration " << iter - 1 << |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3188 ": a few Ritz values of the " << p << "-by-" << |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3189 p << " matrix\n"; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3190 for (int i = 0 ; i < k; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3191 os << " " << workl[iptr(5)+i-1] << "\n"; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3192 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3193 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3194 // 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
|
3195 // iteration pointer. But as workl[iptr(5)-1] is |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3196 // an output value updated at each iteration, setting |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3197 // 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
|
3198 // is a way of obtaining the iteration counter. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3199 if (ido != 99) |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3200 workl[iptr(5)-1] = octave_NaN; |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3201 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3202 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3203 if (ido == -1 || ido == 1 || ido == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3204 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3205 Complex *ip2 = workd + iptr(0) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3206 ComplexColumnVector x(n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3207 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3208 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3209 x(i) = *ip2++; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3210 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3211 ComplexColumnVector y = fun (x, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3212 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3213 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3214 return false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3215 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3216 ip2 = workd + iptr(1) - 1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3217 for (octave_idx_type i = 0; i < n; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3218 *ip2++ = y(i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3219 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3220 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3221 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3222 if (info < 0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3223 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3224 ("eigs: error %d in dsaupd", info); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3225 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3226 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3227 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3228 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3229 while (1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3230 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3231 octave_idx_type info2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3232 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3233 // 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
|
3234 // 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
|
3235 // 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
|
3236 // 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
|
3237 // 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
|
3238 // 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
|
3239 // avoid problems. |
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3240 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
|
3241 octave_idx_type *sel = s.fortran_vec (); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3242 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3243 eig_vec.resize (n, k); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3244 Complex *z = eig_vec.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3245 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3246 eig_val.resize (k+1); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3247 Complex *d = eig_val.fortran_vec (); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3248 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3249 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3250 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3251 F77_FUNC (zneupd, ZNEUPD) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3252 (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
|
3253 F77_CONST_CHAR_ARG2 (&bmat, 1), n, |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3254 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3255 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
|
3256 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
|
3257 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3258 if (f77_exception_encountered) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3259 (*current_liboctave_error_handler) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3260 ("eigs: unrecoverable exception encountered in zneupd"); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3261 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3262 if (info2 == 0) |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3263 { |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3264 octave_idx_type k2 = k / 2; |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3265 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
|
3266 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3267 Complex ctmp = d[i]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3268 d[i] = d[k - i - 1]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3269 d[k - i - 1] = ctmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3270 } |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14846
diff
changeset
|
3271 eig_val.resize (k); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3272 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3273 if (rvec) |
10314
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 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3276 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3277 for (octave_idx_type i = 0; i < k2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3278 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3279 octave_idx_type off1 = i * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3280 octave_idx_type off2 = (k - i - 1) * n; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3281 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3282 if (off1 == off2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3283 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3284 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3285 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3286 ctmp[j] = z[off1 + j]; |
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 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3289 z[off1 + j] = z[off2 + j]; |
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 for (octave_idx_type j = 0; j < n; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3292 z[off2 + j] = ctmp[j]; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3293 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3294 } |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3295 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3296 else |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
20974
diff
changeset
|
3297 (*current_liboctave_error_handler) ("eigs: error %d in zneupd", info2); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3298 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3299 return ip(4); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3300 } |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3301 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20232
diff
changeset
|
3302 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL) |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3303 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3304 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3305 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3306 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3307 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3308 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3309 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3310 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3311 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
|
3312 int maxit = 300); |
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 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3315 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3316 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3317 octave_idx_type &info, Matrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3318 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3319 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3320 std::ostream& os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3321 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3322 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
|
3323 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3324 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3325 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3326 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3327 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
|
3328 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3329 ColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3330 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3331 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3332 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3333 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
|
3334 int maxit = 300); |
8417
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 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3337 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3338 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
|
3339 octave_idx_type &info, Matrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3340 ColumnVector &eig_val, const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3341 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3342 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3343 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3344 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
|
3345 int maxit = 300); |
8417
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 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3348 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3349 const std::string &typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3350 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3351 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3352 Matrix &eig_vec, ColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3353 ColumnVector &resid, std::ostream &os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3354 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3355 bool rvec = false, bool cholB = 0, int disp = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3356 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3357 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3358 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3359 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3360 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3361 octave_idx_type &info, ComplexMatrix &eig_vec, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3362 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3363 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3364 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3365 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3366 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
|
3367 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3368 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3369 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3370 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3371 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3372 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
|
3373 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3374 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3375 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3376 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3377 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3378 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
|
3379 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3380 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3381 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3382 EigsRealNonSymmetricMatrixShift (const Matrix& m, double 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, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3384 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3385 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3386 ComplexColumnVector &eig_val, const Matrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3387 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3388 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3389 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3390 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
|
3391 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3392 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3393 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3394 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3395 octave_idx_type k, octave_idx_type p, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3396 octave_idx_type &info, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3397 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3398 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3399 const SparseMatrix& b, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3400 ColumnVector &permB, ColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3401 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3402 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3403 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
|
3404 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3405 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3406 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3407 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3408 const std::string &_typ, double sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3409 octave_idx_type k, octave_idx_type p, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3410 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3411 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3412 ColumnVector &resid, std::ostream& os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3413 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3414 bool rvec = false, bool cholB = 0, int disp = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3415 int maxit = 300); |
8417
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 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3418 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3419 octave_idx_type k, octave_idx_type p, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3420 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
|
3421 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3422 const ComplexMatrix& b, ColumnVector &permB, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3423 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3424 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3425 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3426 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
|
3427 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3428 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3429 extern octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3430 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3431 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
|
3432 octave_idx_type p, octave_idx_type &info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3433 ComplexMatrix &eig_vec, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3434 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3435 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3436 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3437 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3438 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3439 double tol = std::numeric_limits<double>::epsilon (), |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3440 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
|
3441 int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3442 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3443 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3444 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3445 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
|
3446 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3447 ComplexMatrix &eig_vec, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3448 ComplexColumnVector &eig_val, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3449 const ComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3450 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3451 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3452 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3453 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3454 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3455 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3456 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3457 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3458 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3459 Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3460 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
|
3461 octave_idx_type &info, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3462 ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3463 ComplexColumnVector &eig_val, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3464 const SparseComplexMatrix& b, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3465 ColumnVector &permB, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3466 ComplexColumnVector &resid, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3467 std::ostream &os, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3468 double tol = std::numeric_limits<double>::epsilon (), |
10361
b4f67ca318d8
eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents:
10350
diff
changeset
|
3469 bool rvec = false, bool cholB = 0, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3470 int disp = 0, int maxit = 300); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3471 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3472 extern octave_idx_type |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3473 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3474 const std::string &_typ, Complex sigma, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3475 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
|
3476 octave_idx_type &info, ComplexMatrix &eig_vec, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3477 ComplexColumnVector &eig_val, |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3478 ComplexColumnVector &resid, std::ostream& os, |
15220
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3479 double tol = std::numeric_limits<double>::epsilon (), |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3480 bool rvec = false, bool cholB = 0, |
61822c866ba1
use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents:
15020
diff
changeset
|
3481 int disp = 0, int maxit = 300); |
14144
834df9f10963
remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
3482 #endif |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3483 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3484 #ifndef _MSC_VER |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3485 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3486 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3487 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3488 template octave_idx_type |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3489 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3490 ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3491 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3492 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3493 lusolve (const Matrix&, const Matrix&, Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3494 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3495 template octave_idx_type |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3496 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3497 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3498 template ComplexMatrix |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
3499 ltsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3500 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3501 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3502 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3503 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3504 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3505 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3506 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3507 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3508 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3509 ltsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3510 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3511 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3512 utsolve (const SparseComplexMatrix&, const ColumnVector&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
3513 const ComplexMatrix&); |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3514 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3515 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3516 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3517 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3518 template ComplexMatrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3519 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3520 |
14711
f5c3de9502b2
Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents:
14144
diff
changeset
|
3521 template Matrix |
8417
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3522 utsolve (const Matrix&, const ColumnVector&, const Matrix&); |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3523 #endif |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3524 |
654bcfb937bf
Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3525 #endif |