annotate liboctave/numeric/eigs-base.cc @ 21145:307096fb67e1

revamp sparse Cholesky factorization classes * sparse-chol.h, sparse-chol.cc: Rename from sparse-base-chol.h and sparse-base-chol.cc, respectively. (class sparse_chol): Rename from sparse_base_chol. Incorporate code from SparseCmplxCHOL and SparsedbleCHOL classes into the sparse_chol template. Hide representation and HAVE_CHOLMOD macro from public interface. * sparse-chol-inst.cc: New file. * SparseCmplxCHOL.cc, SparseCmplxCHOL.h, SparsedbleCHOL.cc, SparsedbleCHOL.h: Delete. * chol.cc, symbfact.cc, CSparse.cc, dSparse.cc, eigs-base.cc: Change all uses of SparsedbleCHOL and SparseCmplxCHOL to use new sparse_chol template class. * liboctave/numeric/module.mk: Update.
author John W. Eaton <jwe@octave.org>
date Tue, 26 Jan 2016 16:30:54 -0500
parents 538b57866b90
children ea9c05014809
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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"
21145
307096fb67e1 revamp sparse Cholesky factorization classes
John W. Eaton <jwe@octave.org>
parents: 21139
diff changeset
40 #include "sparse-chol.h"
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
41 #include "oct-rand.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
42 #include "dbleCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
43 #include "CmplxCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
44 #include "dbleLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
45 #include "CmplxLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
46
14144
834df9f10963 remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
47 #ifdef HAVE_ARPACK
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
48 typedef ColumnVector (*EigsFunc) (const ColumnVector &x, int &eigs_error);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
49 typedef ComplexColumnVector (*EigsComplexFunc)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
50 (const ComplexColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
51
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
52 // Arpack and blas fortran functions we call.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
53 extern "C"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
54 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
55 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
56 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
57 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
58 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
59 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
60 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
61 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
62 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
63 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
64 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
65 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
66 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
67
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
68 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
69 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
70 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
71 octave_idx_type*, double*, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
72 const octave_idx_type&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
73 F77_CONST_CHAR_ARG_DECL,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
74 const octave_idx_type&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
75 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
76 const octave_idx_type&, const double&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
77 const octave_idx_type&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
78 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
79 octave_idx_type*, double*, double*,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
80 const octave_idx_type&, octave_idx_type&
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
81 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
82 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
83 F77_CHAR_ARG_LEN_DECL);
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
84
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
85 F77_RET_T
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
86 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
87 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
88 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
89 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
90 octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
91 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
92 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
93 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
94 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
95 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
96 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
97
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
98 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
99 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
100 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
101 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
102 double*, const octave_idx_type&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
103 const double&, double*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
104 F77_CONST_CHAR_ARG_DECL,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
105 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
106 F77_CONST_CHAR_ARG_DECL,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
107 octave_idx_type&, const double&, double*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
108 const octave_idx_type&, double*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
109 const octave_idx_type&, octave_idx_type*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
110 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
111 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
112 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
113 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
114 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
115
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
116 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
117 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
118 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
119 const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
120 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
121 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
122 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
123 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
124 octave_idx_type*, Complex*, Complex*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
125 const octave_idx_type&, double *, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
126 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
127 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
128
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
129 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
130 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
131 F77_CONST_CHAR_ARG_DECL,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
132 octave_idx_type*, Complex*, Complex*,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
133 const octave_idx_type&, const Complex&, Complex*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
134 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
135 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
136 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
137 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
138 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
139 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
140 octave_idx_type*, Complex*, Complex*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
141 const octave_idx_type&, double *, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
142 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
143 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
144 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
145
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
146 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
147 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
148 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
149 const double&, const double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
150 const octave_idx_type&, const double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
151 const octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
152 const octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
153 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
154
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
155
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
156 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
157 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
158 const octave_idx_type&, const octave_idx_type&,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
159 const Complex&, const Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
160 const octave_idx_type&, const Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
161 const octave_idx_type&, const Complex&, Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
162 const octave_idx_type&
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
163 F77_CHAR_ARG_LEN_DECL);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
164
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
165 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
166
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
167
20791
f7084eae3318 maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents: 20232
diff changeset
168 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
169 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
170 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
171
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
172 static octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
173 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
174 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
175
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
176 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
177 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
178
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
179 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
180 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
181
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
182 static ComplexMatrix
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
183 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
184 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
185
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
186 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
187 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
188
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
189 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
190 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
191
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
192 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
193 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
194
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
195 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
196 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
197
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
198 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
199 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
200
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
201 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
202 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
203
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
204 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
205 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
206
12202
dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents: 12198
diff changeset
207 #endif
dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents: 12198
diff changeset
208
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
209 static void
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
210 warn_convergence (void)
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
211 {
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
212 (*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
213 ("Octave:convergence",
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
214 "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
215 "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
216 }
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
217
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
218 template <typename M, typename SM>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
219 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
220 lusolve (const SM& L, const SM& U, M& m)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
221 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
222 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
223 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
224 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
225
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
226 // 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
227 m = L.solve (m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
228 if (err)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
229 return err;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
230
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
231 m = U.solve (utyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
232
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
233 return err;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
234 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
235
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
236 template <typename SM, typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
237 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
238 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
239 {
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
240 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
241 octave_idx_type b_nc = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
242 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
243 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
244 MatrixType ltyp (MatrixType::Lower);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
245 M tmp = L.solve (ltyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
246 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
247 const double* qv = Q.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
248
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
249 if (! err)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
250 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
251 retval.resize (n, b_nc);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
252 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
253 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
254 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
255 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
256 tmp.elem (i,j);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
257 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
258 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
259
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
260 return retval;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
261 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
262
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
263 template <typename SM, typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
264 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
265 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
266 {
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
267 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
268 octave_idx_type b_nc = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
269 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
270 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
271 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
272
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
273 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
274 const double* qv = Q.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
275 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
276 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
277 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
278 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
279 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
280 return U.solve (utyp, retval, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
281 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
282
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
283 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
284 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
285 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
286 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
287
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
288 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
289 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
290
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
291 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
292 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
293 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
294
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
295 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
296 }
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 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
299 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
300 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
301 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
302 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
303
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
304 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
305 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
306 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
307 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
308
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
309 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
310 (*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
311
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
312 return true;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
313 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
314
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
315 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
316 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
317 Complex* y)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
318 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
319 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
320
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
321 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
322 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
323
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
324 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
325 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
326 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
327
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
328 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
329 }
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 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
332 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
333 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
334 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
335 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
336
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
337 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
338 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
339 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
340 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
341
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
342 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
343 (*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
344
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
345 return true;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
346 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
347
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
348 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
349 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
350 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
351 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
352 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
353 octave_idx_type n = b.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
354
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
355 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
356 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
357 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
358 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
359 bt = fact.chol_matrix ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
360 b = bt.transpose ();
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
361 permB = ColumnVector (n);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
362 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
363 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
364 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
365 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
366 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
367
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
368 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
369 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
370 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
371 octave_idx_type info;
21145
307096fb67e1 revamp sparse Cholesky factorization classes
John W. Eaton <jwe@octave.org>
parents: 21139
diff changeset
372 sparse_chol<SparseMatrix> fact (b, info, false);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
373
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
374 if (fact.P () != 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
375 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
376 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
377 {
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
378 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
379 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
380 permB = fact.perm () - 1.0;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
381 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
382 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
383 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
384
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
385 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
386 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
387 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
388 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
389 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
390 octave_idx_type n = b.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
391
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
392 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
393 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
394 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
395 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
396 bt = fact.chol_matrix ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
397 b = bt.hermitian ();
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
398 permB = ColumnVector (n);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
399 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
400 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
401 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
402 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
403 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
404
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
405 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
406 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
407 ColumnVector& permB)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
408 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
409 octave_idx_type info;
21145
307096fb67e1 revamp sparse Cholesky factorization classes
John W. Eaton <jwe@octave.org>
parents: 21139
diff changeset
410 sparse_chol<SparseComplexMatrix> fact (b, info, false);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
411
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
412 if (fact.P () != 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
413 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
414 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
415 {
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
416 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
417 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
418 permB = fact.perm () - 1.0;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
419 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
420 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
421 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
422
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
423 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
424 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
425 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
426 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
427 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
428 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
429 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
430 octave_idx_type n = m.rows ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
431
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
432 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
433 SparseMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
434
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
435 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
436 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
437 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
438 {
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
439 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
440 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
441 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
442 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
443 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
444 tmp.xcidx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
445 tmp.xridx (i) =
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
446 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
447 tmp.xdata (i) = 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
448 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
449 tmp.xcidx (n) = n;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
450
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
451 AminusSigmaB -= sigma * tmp *
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
452 b.transpose () * b * tmp.transpose ();
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
453 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
454 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
455 AminusSigmaB -= sigma * b.transpose () * b;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
456 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
457 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
458 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
459 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
460 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
461 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
462 SparseMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
463
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
464 // Create sigma * speye (n,n)
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
465 sigmat.xcidx (0) = 0;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
466 for (octave_idx_type i = 0; i < n; i++)
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
467 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
468 sigmat.xdata (i) = sigma;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
469 sigmat.xridx (i) = i;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
470 sigmat.xcidx (i+1) = i + 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
471 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
472
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
473 AminusSigmaB -= sigmat;
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
474 }
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
475
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
476 SparseLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
477
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
478 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
479 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
480 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
481 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
482
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
483 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
484 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
485 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
486 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
487 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
488
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
489 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
490 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
491 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
492 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
493 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
494 double d = 0.;
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
495 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
496 && 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
497 d = std::abs (U.xdata (U.xcidx (j+1)-1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
498
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
499 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
500 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
501
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
502 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
503 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
504 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
505
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
506 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
507 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
508
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
509 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
510 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
511
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
512 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
513 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
514
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
515 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
516 LuAminusSigmaB (const Matrix &m, const Matrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
517 bool cholB, const ColumnVector& permB, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
518 Matrix &L, Matrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
519 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
520 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
521 bool have_b = ! b.is_empty ();
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
522 octave_idx_type n = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
523
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
524 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
525 Matrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
526
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
527 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
528 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
529 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
530 {
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
531 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
532 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
533 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
534
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
535 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
536 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
537 for (octave_idx_type j = 0;
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
538 j < b.cols (); j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
539 for (octave_idx_type i = 0;
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
540 i < b.rows (); i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
541 *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
542 static_cast<octave_idx_type>(pB[j]));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
543 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
544 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
545 AminusSigmaB -= tmp;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
546 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
547 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
548 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
549 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
550 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
551 {
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
552 double *p = AminusSigmaB.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
553
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
554 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
555 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
556 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
557
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
558 LU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
559
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
560 L = fact.P ().transpose () * fact.L ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
561 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
562 for (octave_idx_type j = 0; j < n; j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
563 P[j] = Q[j] = j;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
564
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
565 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
566 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
567 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
568 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
569 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
570 double d = std::abs (U.xelem (j,j));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
571 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
572 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
573
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
574 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
575 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
576 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
577
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
578 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
579 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
580
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
581 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
582 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
583
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
584 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
585 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
586
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
587 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
588 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
589 bool cholB, const ColumnVector& permB, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
590 SparseComplexMatrix &L, SparseComplexMatrix &U,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
591 octave_idx_type *P, octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
592 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
593 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
594 octave_idx_type n = m.rows ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
595
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
596 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
597 SparseComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
598
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
599 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
600 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
601 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
602 {
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
603 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
604 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
605 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
606 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
607 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
608 tmp.xcidx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
609 tmp.xridx (i) =
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
610 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
611 tmp.xdata (i) = 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
612 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
613 tmp.xcidx (n) = n;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
614
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
615 AminusSigmaB -= tmp * b.hermitian () * b *
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
616 tmp.transpose () * sigma;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
617 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
618 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
619 AminusSigmaB -= sigma * b.hermitian () * b;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
620 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
621 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
622 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
623 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
624 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
625 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
626 SparseComplexMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
627
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
628 // Create sigma * speye (n,n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
629 sigmat.xcidx (0) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
630 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
631 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
632 sigmat.xdata (i) = sigma;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
633 sigmat.xridx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
634 sigmat.xcidx (i+1) = i + 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
635 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
636
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
637 AminusSigmaB -= sigmat;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
638 }
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 SparseComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
641
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
642 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
643 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
644 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
645 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
646
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
647 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
648 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
649 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
650 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
651 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
652
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
653 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
654 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
655 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
656 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
657 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
658 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
659 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
660 && 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
661 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
662
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
663 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
664 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
665
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
666 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
667 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
668 }
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 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
671 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
672
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
673 if (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
674 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
675
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
676 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
677 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
678
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
679 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
680 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
681 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
682 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
683 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
684 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
685 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
686 octave_idx_type n = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
687
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
688 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
689 ComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
690
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
691 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
692 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
693 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
694 {
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
695 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
696 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
697 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
698
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
699 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
700 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
701 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
702 j < b.cols (); j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
703 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
704 i < b.rows (); i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
705 *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
706 static_cast<octave_idx_type>(pB[j]));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
707 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
708 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
709 AminusSigmaB -= tmp;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
710 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
711 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
712 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
713 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
714 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
715 {
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
716 Complex *p = AminusSigmaB.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
717
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
718 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
719 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
720 }
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 ComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
723
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
724 L = fact.P ().transpose () * fact.L ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
725 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
726 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
727 P[j] = Q[j] = j;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
728
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
729 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
730 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
731 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
732 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
733 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
734 double d = std::abs (U.xelem (j,j));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
735 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
736 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
737
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
738 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
739 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
740 }
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 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
743 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
744
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
745 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
746 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
747
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
748 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
749 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
750
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
751 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
752 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
753 EigsRealSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
754 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
755 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
756 ColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
757 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
758 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
759 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
760 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
761 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
762 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
763 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
764 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
765 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
766 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
767 double sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
768 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
769
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
770 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
771 (*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
772 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
773 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
774 ("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
775
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
776 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
777 {
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
778 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
779 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
780 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
781 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
782 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
783
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
784 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
785 (*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
786
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
787 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
788 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
789 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
790
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
791 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
792 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
793
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
794 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
795 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
796 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
797
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
798 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
799 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
800 ("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
801 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
802
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
803 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
804 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
805 ("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
806
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
807 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
808 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
809 // 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
810 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
811 (*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
812
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
813 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
814 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
815 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
816 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
817
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
818 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
819 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
820 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
821 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
822
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
823 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
824 && 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
825 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
826 (*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
827
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
828 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
829 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
830 ("eigs: invalid sigma value for real symmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
831
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
832 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
833 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
834 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
835 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
836 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
837 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
838 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
839 b = b.transpose ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
840 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
841 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
842 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
843 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
844 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
845 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
846 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
847 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
848 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
849 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
850 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
851 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
852 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
853 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
854
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
855 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
856 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
857
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
858 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
859 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
860 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
861 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
862 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
863 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
864 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
865 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
866 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
867 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
868 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
869 // 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
870
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
871 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
872 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
873
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
874 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
875 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
876 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
877
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
878 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
879 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
880 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
881 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
882
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
883 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
884 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
885 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
886 (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
887 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
888 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
889 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
890 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
891
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
892 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
893 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
894 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
895
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
896 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
897 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
898 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
899 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
900 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
901 ": 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
902 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
903 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
904 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
905 }
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 // 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
908 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
909 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
910 // 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
911 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
912 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
913 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
914 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
915
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
916 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
917 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
918 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
919 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
920 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
921 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
922 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
923
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
924 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
925
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
926 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
927 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
928 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
929 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
930 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
931 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
932 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
933 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
934 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
935 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
936 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
937 ("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
938
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
939 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
940 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
941 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
942 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
943
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
944 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
945
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
946 // 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
947 // 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
948 // 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
949 // 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
950 // 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
951 // 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
952 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
953 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
954 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
955
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
956 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
957 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
958
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
959 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
960 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
961
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
962 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
963 (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
964 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
965 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
966 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
967 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
968
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
969 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
970 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
971 ("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
972
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
973 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
974 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
975 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
976 if (typ != "SM" && typ != "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
977 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
978 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
979 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
980 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
981 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
982 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
983 }
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 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
987 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
988 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
989 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
990 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
991
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
992 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
993 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
994 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
995 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
996
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
997 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
998 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
999
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1000 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
1001 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
1002
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1003 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
1004 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
1005
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1006 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
1007 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1008 }
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
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1011 if (note3)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1012 eig_vec = ltsolve (b, permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1013 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1014 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1015 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1016 (*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
1017
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1018 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1019 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1020
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
1021 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1022 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1023 EigsRealSymmetricMatrixShift (const M& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1024 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
1025 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1026 ColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1027 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1028 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1029 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1030 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1031 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1032 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1033 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
1034 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1035 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1036
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
1037 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
1038 (*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
1039 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
1040 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1041 ("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
1042
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1043 // 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
1044 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1045 // 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
1046 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1047 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1048
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
1049 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1050 {
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
1051 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
1052 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1053 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
1054 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1055 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1056
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1057 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1058 (*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
1059
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1060 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
1061 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1062 ("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
1063 " Use 'eig (full (A))' instead");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1064
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1065 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1066 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1067 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1068
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1069 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1070 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1071
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1072 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1073 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1074 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1075
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1076 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
1077 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1078 ("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
1079
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1080 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1081 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1082 // 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
1083 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
1084 (*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
1085
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1086 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
1087 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
1088 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1089 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
1090
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1091 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
1092 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1093 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1094 }
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 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1097 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1098 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1099
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1100 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
1101 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1102
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1103 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1104 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1105 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1106 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1107 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
1108 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1109 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1110 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1111 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1112 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1113 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1114 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1115
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1116 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
1117 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1118
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1119 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1120 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1121 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1122
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
1123 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
1124 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
1125
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1126 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
1127 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1128
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1129 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1130
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1131 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1132 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1133 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1134 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1135
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1136 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1137 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1138 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1139 (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
1140 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1141 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1142 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1143 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
1144
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1145 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
1146 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1147 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1148
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1149 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1150 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1151 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1152 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1153 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1154 ": 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
1155 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1156 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1157 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1158 }
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 // 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
1161 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1162 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1163 // 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
1164 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1165 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1166 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1167 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1168
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1169 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1170 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1171 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1172 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1173 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1174 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1175 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1176
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1177 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1178
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1179 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1180
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1181 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1182 tmp(i,0) = dtmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1183
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1184 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1185
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1186 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1187 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1188 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1189 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1190 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1191 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
1192 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1193 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1194 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1195 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1196
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1197 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1198 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1199
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1200 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1201
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1202 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1203 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1204 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1205 }
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 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1208 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1209 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1210 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1211 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1212 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
1213 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1214 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1215 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1216 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1217 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1218
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1219 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1220 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1221
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1222 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1223
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1224 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1225 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1226 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1227 }
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 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1230 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1231 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1232 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1233 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1234 ("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
1235
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1236 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1237 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1238 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1239 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1240
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1241 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1242
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1243 // 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
1244 // 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
1245 // 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
1246 // 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
1247 // 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
1248 // 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
1249 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1250 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
1251 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
1252
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1253 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1254 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1255
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1256 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1257 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1258
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1259 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1260 (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
1261 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1262 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1263 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
1264 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
1265
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1266 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
1267 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1268 ("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
1269
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1270 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1271 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1272 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
1273 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
1274 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1275 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1276 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
1277 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
1278 }
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 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1281 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1282 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
1283
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1284 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1285 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1286 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
1287 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
1288
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1289 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1290 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1291
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1292 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
1293 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
1294
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1295 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
1296 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
1297
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1298 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
1299 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1300 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1301 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1302 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1303 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1304 (*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
1305
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1306 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1307 }
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 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1310 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1311 const std::string &_typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1312 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
1313 octave_idx_type &info, Matrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1314 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
1315 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1316 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1317 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1318 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1319 bool have_sigma = (sigma ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1320 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1321 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1322 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1323
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
1324 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1325 {
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
1326 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
1327 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1328 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
1329 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1330 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1331
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1332 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1333 (*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
1334
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1335 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1336 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1337 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1338
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1339 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1340 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1341
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1342 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1343 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1344 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1345
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1346 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
1347 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1348 ("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
1349 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1350
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1351 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
1352 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1353 ("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
1354
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1355 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1356 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1357 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
1358 && 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
1359 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1360 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1361
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1362 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
1363 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1364 ("eigs: invalid sigma value for real symmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1365
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1366 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1367 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1368 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1369 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1370 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1371 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1372 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1373 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1374 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1375 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1376 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1377 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1378 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1379 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1380
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1381 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
1382 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1383
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1384 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1385 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1386 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1387 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1388 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
1389 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1390 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1391 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1392 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1393 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1394 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1395 // 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
1396
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1397 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
1398 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1399
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1400 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1401 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1402 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1403
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1404 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1405 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1406 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1407 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1408
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1409 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1410 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1411 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1412 (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
1413 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1414 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1415 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1416 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
1417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1418 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
1419 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1420 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1421
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1422 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1423 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1424 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1425 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1426 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1427 ": 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
1428 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1429 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1430 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1431 }
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 // 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
1434 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1435 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1436 // 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
1437 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1438 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1439 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1440 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1441
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1442
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1443 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1444 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1445 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1446 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1447
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1448 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1449 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1450
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1451 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1452
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1453 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1454 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1455
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1456 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1457 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1458 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1459 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1460 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1461 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1462 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1463 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1464 ("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
1465
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1466 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1467 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1468 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1469 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1470
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1471 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1472
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1473 // 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
1474 // 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
1475 // 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
1476 // 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
1477 // 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
1478 // 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
1479 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1480 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
1481 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
1482
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1483 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1484 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1485
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1486 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1487 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1488
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1489 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1490 (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
1491 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1492 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1493 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
1494 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
1495
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1496 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
1497 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1498 ("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
1499
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1500 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1501 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1502 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
1503 if (typ != "SM" && typ != "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1504 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1505 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
1506 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1507 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1508 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
1509 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
1510 }
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 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1514 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1515 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1516 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1517 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
1518
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1519 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1520 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1521 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
1522 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
1523
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1524 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1525 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1526
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1527 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
1528 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
1529
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1530 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
1531 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
1532
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1533 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
1534 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1535 }
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 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1538 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1539 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1540 (*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
1541
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1542 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1543 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1544
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
1545 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1546 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1547 EigsRealNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1548 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1549 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1550 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1551 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1552 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1553 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1554 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1555 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1556 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1557 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
1558 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1559 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1560 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1561 double sigmar = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1562 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1563 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1564
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
1565 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
1566 (*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
1567 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
1568 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1569 ("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
1570
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
1571 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1572 {
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
1573 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
1574 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1575 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
1576 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1577 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1578
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1579 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1580 (*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
1581
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1582 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1583 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1584 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1585
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1586 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1587 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1588
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1589 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1590 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1591 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1592
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1593 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
1594 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1595 ("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
1596 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1597
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1598 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
1599 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1600 ("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
1601
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1602 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1603 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1604 // 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
1605 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
1606 (*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
1607
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1608 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
1609 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
1610 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1611 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
1612
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1613 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
1614 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1615 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1616 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1617
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1618 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
1619 && 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
1620 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1621 (*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
1622
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1623 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
1624 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1625 ("eigs: invalid sigma value for unsymmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1626
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1627 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1628 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1629 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1630 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1631 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1632 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1633 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
1634 b = b.transpose ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1635 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1636 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1637 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1638 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1639 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1640 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1641 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1642 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1643 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1644 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
1645 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1646 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1647 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1648 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1649
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1650 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
1651 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1652
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1653 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1654 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1655 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1656 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1657 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
1658 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1659 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1660 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1661 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1662 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1663 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1664 // 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
1665
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1666 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
1667 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1668
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1669 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1670 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1671 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1672
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1673 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1674 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1675 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1676 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1677
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1678 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1679 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1680 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1681 (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
1682 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1683 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1684 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1685 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
1686
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1687 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
1688 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1689 ("eigs: unrecoverable exception encountered in dnaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1690
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1691 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1692 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1693 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1694 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1695 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1696 ": 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
1697 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1698 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1699 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1700 }
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 // 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
1703 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1704 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1705 // 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
1706 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1707 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1708 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1709 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1710
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1711 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1712 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1713 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1714 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1715 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1716 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1717 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
1718
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1719 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
1720
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1721 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1722 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1723 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1724 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
1725 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1726 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1727 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1728 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1729 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1730 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1731 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1732 ("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
1733
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1734 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1735 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1736 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1737 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1738
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1739 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1740
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1741 // 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
1742 // 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
1743 // 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
1744 // 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
1745 // 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
1746 // 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
1747 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1748 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
1749 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1750
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1751 // 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
1752 // 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
1753 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1754 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1755 // 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
1756 // [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
1757
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1758 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1759 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1760
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1761 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1762 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1763 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1764 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
1765 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1766
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1767 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1768 (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
1769 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1770 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
1771 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
1772 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1773
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1774 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
1775 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1776 ("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
1777
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1778 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
1779 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
1780
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1781 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1782 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1783 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
1784 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
1785 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1786 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
1787 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1788 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1789 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
1790 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1791 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1792 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
1793 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
1794
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1795 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
1796 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
1797 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1798 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1799 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
1800 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
1801 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1802 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1803
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1804 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1805 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1806 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
1807
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1808 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1809 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1810 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
1811 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
1812
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1813 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1814 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1815
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1816 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
1817 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
1818
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1819 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
1820 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
1821
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1822 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
1823 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1824 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1825
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1826 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
1827 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
1828 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1829 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1830 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
1831 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
1832 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1833 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1834 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
1835 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1836 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
1837 i++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1838 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1839 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1840 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1841 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
1842 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1843 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1844 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
1845 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1846 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
1847 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1848 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1849 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1850 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1851 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1852
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1853 if (note3)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1854 eig_vec = ltsolve (M(b), permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1855 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1856 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1857 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1858 (*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
1859
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1860 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1861 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1862
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
1863 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1864 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1865 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1866 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
1867 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1868 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1869 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1870 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1871 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1872 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1873 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1874 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1875 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1876 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
1877 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1878 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1879 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1880
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
1881 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
1882 (*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
1883 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
1884 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1885 ("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
1886
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1887 // 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
1888 //if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1889 // 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
1890 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1891 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1892
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
1893 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1894 {
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
1895 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
1896 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1897 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
1898 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1899 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1900
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1901 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1902 (*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
1903
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1904 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1905 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1906 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1907
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1908 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1909 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1910
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1911 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1912 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1913 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1914
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1915 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
1916 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1917 ("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
1918 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1919
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1920 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
1921 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1922 ("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
1923
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1924 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1925 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1926 // 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
1927 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
1928 (*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
1929
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1930 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
1931 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
1932 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1933 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
1934
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1935 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
1936 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1937 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1938 }
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 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1941 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1942 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1943
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1944 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
1945 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1946
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1947 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1948 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1949 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1950 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1951 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
1952 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1953 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1954 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1955 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1956 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1957 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1958 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1959
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1960 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
1961 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1962
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1963 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1964 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1965 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1966
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
1967 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
1968 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
1969
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1970 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
1971 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1972
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1973 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1974
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1975 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1976 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1977 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1978 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1979
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1980 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1981 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1982 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1983 (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
1984 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1985 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1986 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1987 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
1988
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1989 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
1990 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1991 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1992
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1993 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1994 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1995 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1996 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1997 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1998 ": 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
1999 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2000 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2001 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2002 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2003
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2004 // 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
2005 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2006 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2007 // 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
2008 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2009 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2010 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2011 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2012
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2013 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2014 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2015 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2016 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2017 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2018 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2019 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2020
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2021 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2022
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2023 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2024
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2025 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2026 tmp(i,0) = dtmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2027
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2028 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2029
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2030 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2031 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2032 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2033 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2034 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2035 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
2036 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2037 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2038 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2039 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2040
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2041 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2042 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2043
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2044 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2045
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2046 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2047 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2048 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2049 }
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 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2052 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2053 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2054 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2055 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2056 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
2057 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2058 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2059 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2060 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2061 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2062
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2063 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2064 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2065
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2066 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2067
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2068 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2069 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2070 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2071 }
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 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2074 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2075 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2076 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2077 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2078 ("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
2079
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2080 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2081 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2082 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2083 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2084
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2085 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2086
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2087 // 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
2088 // 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
2089 // 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
2090 // 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
2091 // 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
2092 // 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
2093 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2094 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
2095 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
2096
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2097 // 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
2098 // 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
2099 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2100 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2101 // 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
2102 // [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
2103
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2104 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2105 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2106
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2107 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2108 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2109 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2110 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
2111 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2112
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2113 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2114 (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
2115 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2116 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
2117 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
2118 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2119
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2120 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
2121 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2122 ("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
2123
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2124 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
2125 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
2126
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2127 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2128 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2129 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
2130 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
2131 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2132 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
2133 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2134 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2135 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
2136 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2137 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2138 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
2139 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
2140
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2141 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
2142 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
2143 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2144 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2145 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
2146 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
2147 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2148 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2149
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2150 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2151 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2152 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
2153
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2154 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2155 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2156 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
2157 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
2158
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2159 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2160 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2161
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2162 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
2163 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
2164
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2165 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
2166 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
2167
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2168 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
2169 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2170 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2171
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2172 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
2173 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
2174 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2175 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2176 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
2177 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
2178 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2179 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2180 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
2181 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2182 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
2183 i++;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2184 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2185 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2186 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2187 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
2188 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2189 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2190 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
2191 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2192 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
2193 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2194 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2195 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2196 }
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 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2199 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2200 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2201 (*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
2202
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2203 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2204 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2205
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2206 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2207 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2208 const std::string &_typ, double sigmar,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2209 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
2210 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2211 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
2212 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2213 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2214 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2215 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2216 bool have_sigma = (sigmar ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2217 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2218 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2219 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2220 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2221
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
2222 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2223 {
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
2224 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
2225 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2226 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
2227 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2228 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2229
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2230 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2231 (*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
2232
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2233 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2234 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2235 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2236
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2237 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2238 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2239
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2240 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2241 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2242 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2243
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2244 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
2245 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2246 ("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
2247 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2248
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2249 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
2250 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2251 ("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
2252
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 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2255 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2256 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
2257 && 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
2258 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2259 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2260
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2261 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
2262 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2263 ("eigs: invalid sigma value for unsymmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2264
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2265 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2266 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2267 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2268 sigmar = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2269 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2270 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2271 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2272 else if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2273 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2274 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2275 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2276 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2277 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2278 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2279
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2280 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
2281 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2282
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2283 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2284 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2285 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2286 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2287 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
2288 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2289 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2290 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2291 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2292 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2293 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2294 // 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
2295
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2296 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
2297 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2298
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2299 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2300 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2301 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2302
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2303 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2304 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2305 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2306 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2307
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2308 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2309 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2310 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2311 (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
2312 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2313 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2314 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2315 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
2316
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2317 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
2318 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2319 ("eigs: unrecoverable exception encountered in dnaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2320
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2321 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2322 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2323 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2324 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2325 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2326 ": 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
2327 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2328 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2329 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2330 }
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 // 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
2333 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2334 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2335 // 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
2336 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2337 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2338 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2339 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2340
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2341 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2342 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2343 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2344 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2345
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2346 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2347 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2348
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2349 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2350
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2351 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2352 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2353
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2354 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2355 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2356 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2357 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2358 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2359 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2360 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2361 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2362 ("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
2363
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2364 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2365 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2366 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2367 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2368
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2369 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2370
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2371 // 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
2372 // 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
2373 // 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
2374 // 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
2375 // 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
2376 // 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
2377 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2378 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
2379 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2380
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2381 // 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
2382 // 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
2383 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2384 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2385 // 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
2386 // [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
2387
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2388 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2389 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2390
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2391 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2392 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2393 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2394 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
2395 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2396
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2397 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2398 (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
2399 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2400 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
2401 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
2402 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2403
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2404 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
2405 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2406 ("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
2407
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2408 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
2409 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
2410
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2411 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2412 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2413 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
2414 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
2415 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2416 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
2417 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2418 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2419 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
2420 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2421 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2422 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
2423 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
2424
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2425 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
2426 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
2427 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2428 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2429 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
2430 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
2431 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2432 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2433
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2434 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2435 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2436 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
2437
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2438 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2439 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2440 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
2441 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
2442
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2443 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2444 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2445
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2446 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
2447 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
2448
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2449 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
2450 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
2451
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2452 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
2453 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2454 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2455
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2456 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
2457 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
2458 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2459 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2460 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
2461 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
2462 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2463 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2464 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
2465 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2466 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
2467 i++;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2468 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2469 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2470 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2471 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
2472 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2473 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2474 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
2475 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2476 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
2477 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2478 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2479 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2480 }
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 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2483 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2484 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2485 (*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
2486
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2487 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2488 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2489
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
2490 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2491 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2492 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2493 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2494 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2495 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2496 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2497 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2498 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2499 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2500 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2501 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2502 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2503 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
2504 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2505 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2506 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2507 Complex sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2508 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2509
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
2510 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
2511 (*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
2512 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
2513 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2514 ("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
2515
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
2516 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2517 {
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
2518 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
2519 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2520 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
2521 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2522 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2523 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
2524 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
2525 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2526 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2527
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2528 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2529 (*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
2530
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2531 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2532 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2533 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2534
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2535 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2536 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2537
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2538 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2539 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2540 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2541
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2542 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
2543 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2544 ("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
2545 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2546
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2547 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
2548 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2549 ("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
2550
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2551 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2552 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2553 // 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
2554 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
2555 (*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
2556
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2557 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
2558 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
2559 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2560 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
2561
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2562 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
2563 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2564 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2565 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2566
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2567 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
2568 && 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
2569 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2570 (*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
2571
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2572 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
2573 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2574 ("eigs: invalid sigma value for complex problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2575
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2576 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2577 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2578 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2579 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2580 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2581 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2582 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
2583 b = b.hermitian ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2584 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2585 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2586 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2587 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2588 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2589 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2590 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2591 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2592 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2593 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
2594 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2595 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2596 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2597 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2598
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2599 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
2600 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2601
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2602 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2603 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2604 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2605 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2606 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
2607 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2608 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2609 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2610 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2611 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2612 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2613 // 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
2614
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2615 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
2616 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2617
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2618 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2619 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2620 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
2621
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2622 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2623 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2624 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2625 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2626 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2627
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2628 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2629 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2630 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2631 (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
2632 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2633 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2634 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2635 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
2636
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2637 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
2638 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2639 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2640
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2641 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2642 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2643 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2644 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2645 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2646 ": 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
2647 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2648 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2649 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2650 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2651
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2652 // 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
2653 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2654 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2655 // 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
2656 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2657 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2658 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2659 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2660
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2661 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2662 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2663 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2664 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2665 ComplexMatrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2666 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2667 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
2668 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
2669 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2670 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2671
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2672 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2673 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
2674 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2675 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2676 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2677 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2678 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2679 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2680 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2681 ("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
2682
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2683 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2684 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2685 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2686 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2687
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2688 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2689
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2690 // 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
2691 // 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
2692 // 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
2693 // 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
2694 // 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
2695 // 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
2696 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2697 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
2698 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2699
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2700 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2701 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2702
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2703 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2704 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2705
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2706 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2707
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2708 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2709 (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
2710 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2711 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2712 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
2713 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
2714
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2715 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
2716 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2717 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2718
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2719 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2720 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2721 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2722 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
2723 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2724 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2725 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2726 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2727 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2728 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2729
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2730 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2731 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2732 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2733
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2734 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2735 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2736 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2737 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2738
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2739 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2740 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2741
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2742 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2743 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2744
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2745 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2746 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2747
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2748 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2749 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2750 }
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 if (note3)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2753 eig_vec = ltsolve (b, permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2754 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2755 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2756 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2757 (*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
2758
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2759 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2760 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2761
21139
538b57866b90 consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents: 21136
diff changeset
2762 template <typename M>
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2763 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2764 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2765 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
2766 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2767 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2768 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2769 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2770 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2771 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2772 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2773 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2774 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2775 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2776 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
2777 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2778 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2779
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2780 if (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
2781 (*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
2782 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
2783 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2784 ("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
2785
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2786 // 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
2787 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2788 // 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
2789 // eig_val, _b, permB, cresid, os, tol,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2790 // rvec, cholB, disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2791
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
2792 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2793 {
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
2794 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
2795 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2796 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
2797 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2798 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2799 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
2800 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
2801 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2802 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2803
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2804 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2805 (*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
2806
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2807 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2808 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2809 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2810
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2811 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2812 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2813
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2814 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2815 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2816 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2817
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2818 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
2819 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2820 ("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
2821 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2822
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2823 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
2824 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2825 ("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
2826
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2827 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2828 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2829 // 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
2830 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
2831 (*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
2832
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2833 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
2834 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
2835 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2836 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
2837
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2838 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
2839 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2840 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2841 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2842
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2843 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2844 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2845 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2846
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2847 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
2848 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2849
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2850 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2851 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2852 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2853 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2854 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
2855 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2856 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2857 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2858 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2859 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2860 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2861 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2862
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2863 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
2864 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2865
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2866 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2867 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2868 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2869
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
2870 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
2871 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
2872
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2873 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
2874 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2875
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2876 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
2877
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2878 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2879 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2880 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2881 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2882 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2883
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2884 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2885 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2886 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2887 (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
2888 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2889 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2890 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2891 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
2892
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2893 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
2894 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2895 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2896
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2897 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2898 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2899 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2900 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2901 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2902 ": 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
2903 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2904 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2905 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2906 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2907
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2908 // 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
2909 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2910 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2911 // 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
2912 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2913 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2914 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2915 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2916
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2917 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2918 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2919 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2920 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2921 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2922 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2923 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2924
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2925 vector_product (m, workd+iptr(0)-1, ctmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2926
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2927 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2928
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2929 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2930 tmp(i,0) = ctmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2931
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2932 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2933
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2934 Complex *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2935 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2936 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2937 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2938 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2939 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
2940 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2941 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2942 Complex *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2943 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2944
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2945 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2946 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2947
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2948 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2949
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2950 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2951 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2952 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2953 }
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 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2956 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2957 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2958 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2959 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2960 workd[iptr(0) + i - 1] =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2961 workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2962 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2963 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2964 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2965 Complex *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2966 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2967
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2968 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2969 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2970
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2971 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2972
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2973 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2974 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2975 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2976 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2977 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2978 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2979 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2980 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2981 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2982 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2983 ("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
2984
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2985 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2986 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2987 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2988 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2989
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2990 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2991
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2992 // 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
2993 // 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
2994 // 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
2995 // 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
2996 // 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
2997 // 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
2998 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2999 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
3000 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3001
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3002 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3003 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3004
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3005 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3006 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3007
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3008 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3009
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3010 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3011 (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
3012 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3013 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3014 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
3015 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
3016
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3017 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
3018 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3019 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3020
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3021 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3022 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3023 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3024 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
3025 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3026 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3027 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3028 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3029 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3030 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3031
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3032 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3033 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3034 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3035
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3036 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3037 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3038 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3039 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3040
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3041 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3042 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3043
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3044 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3045 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3046
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3047 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3048 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3049
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3050 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3051 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3052 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3053 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3054 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3055 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3056 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3057 ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3058
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3059 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3060 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3061
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3062 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3063 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3064 const std::string &_typ, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3065 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
3066 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3067 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3068 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
3069 double tol, bool rvec, bool /* cholB */,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3070 int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3071 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3072 std::string typ (_typ);
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3073 bool have_sigma = (std::abs (sigma) ? true : false);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3074 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3075 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3076 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3077
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
3078 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3079 {
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
3080 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
3081 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3082 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
3083 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3084 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3085 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
3086 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
3087 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3088 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3089
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3090 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3091 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3092 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3093
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3094 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3095 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3096 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3097
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3098 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3099 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3100
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3101 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3102 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3103 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3104
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3105 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
3106 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3107 ("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
3108 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3109
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3110 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
3111 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3112 ("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
3113
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3114 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3115 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
3116 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
3117 && 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
3118 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3119 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3120
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3121 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
3122 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3123 ("eigs: invalid sigma value for complex problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3124
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3125 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3126 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3127 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3128 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3129 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3130 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3131 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3132 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3133 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3134 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3135 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3136 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3137 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3138 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3139
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3140 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
3141 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3142
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3143 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3144 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3145 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3146 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3147 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
3148 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3149 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3150 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3151 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3152 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3153 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3154 // 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
3155
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3156 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
3157 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3158
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3159 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3160 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3161 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
3162
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3163 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3164 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3165 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3166 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3167 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3168
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3169 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3170 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3171 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3172 (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
3173 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3174 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3175 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3176 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
3177
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3178 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
3179 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3180 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3181
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
3182 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3183 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3184 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3185 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3186 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3187 ": 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
3188 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3189 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3190 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3191 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3192
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3193 // 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
3194 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3195 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3196 // 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
3197 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3198 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3199 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3200 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3201
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3202 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3203 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3204 Complex *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3205 ComplexColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3206
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3207 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3208 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3209
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3210 ComplexColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3211
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3212 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3213 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3214
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3215 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3216 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3217 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3218 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3219 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3220 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3221 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3222 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3223 ("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
3224
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3225 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3226 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3227 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3228 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3229
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3230 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3231
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3232 // 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
3233 // 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
3234 // 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
3235 // 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
3236 // 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
3237 // 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
3238 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3239 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
3240 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3241
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3242 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3243 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3244
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3245 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3246 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3247
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3248 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3249
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3250 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3251 (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
3252 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3253 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3254 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
3255 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
3256
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3257 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
3258 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3259 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3260
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3261 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3262 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3263 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3264 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
3265 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3266 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3267 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3268 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3269 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3270 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3271
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3272 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3273 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3274 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3275
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3276 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3277 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3278 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3279 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3280
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3281 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3282 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3283
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3284 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3285 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3286
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3287 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3288 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3289
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3290 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3291 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3292 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3293 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3294 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3295 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3296 (*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
3297
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3298 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3299 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3300
20791
f7084eae3318 maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents: 20232
diff changeset
3301 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3302 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3303 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3304 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3305 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3306 ColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3307 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
3308 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3309 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
3310 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
3311 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3312
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3313 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3314 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3315 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3316 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3317 ColumnVector &eig_val, const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3318 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
3319 std::ostream& os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3320 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
3321 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
3322 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3323
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3324 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3325 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3326 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
3327 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3328 ColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3329 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
3330 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3331 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
3332 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
3333 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3334
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3335 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3336 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3337 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
3338 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3339 ColumnVector &eig_val, const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3340 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
3341 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3342 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
3343 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
3344 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3345
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3346 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3347 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3348 const std::string &typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3349 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3350 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3351 Matrix &eig_vec, ColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3352 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
3353 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
3354 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
3355 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3356
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3357 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3358 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3359 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3360 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3361 ComplexColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3362 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
3363 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3364 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
3365 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
3366 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3367
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3368 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3369 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3370 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3371 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
3372 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3373 const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3374 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
3375 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3376 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
3377 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
3378 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3379
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3380 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3381 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3382 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3383 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3384 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3385 ComplexColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3386 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
3387 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3388 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
3389 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
3390 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3391
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3392 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3393 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3394 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3395 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3396 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3397 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3398 const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3399 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
3400 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3401 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
3402 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
3403 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3404
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3405 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3406 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3407 const std::string &_typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3408 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
3409 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3410 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3411 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
3412 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
3413 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
3414 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3415
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3416 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3417 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3418 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3419 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
3420 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3421 const ComplexMatrix& b, ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3422 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3423 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3424 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
3425 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
3426 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3427
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3428 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3429 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3430 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
3431 octave_idx_type p, octave_idx_type &info,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3432 ComplexMatrix &eig_vec,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3433 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3434 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3435 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3436 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3437 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3438 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
3439 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
3440 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3441
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3442 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3443 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3444 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
3445 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3446 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3447 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3448 const ComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3449 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3450 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3451 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3452 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
3453 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3454 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3455
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3456 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3457 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3458 Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3459 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
3460 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3461 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3462 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3463 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3464 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3465 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3466 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3467 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
3468 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3469 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3470
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3471 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3472 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3473 const std::string &_typ, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3474 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
3475 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3476 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3477 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
3478 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
3479 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
3480 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
3481 #endif
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3482
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3483 #ifndef _MSC_VER
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3484 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3485 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3486
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3487 template octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3488 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3489 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3490
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3491 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3492 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3493
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3494 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3495 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3496
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3497 template ComplexMatrix
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3498 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3499 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3500
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3501 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3502 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3503
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3504 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3505 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3506
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3507 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3508 ltsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3509
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3510 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3511 utsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3512 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3513
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3514 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3515 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3516
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3517 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3518 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3519
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3520 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3521 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3522 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3523
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3524 #endif