annotate liboctave/numeric/eigs-base.cc @ 21602:47c76e56a1de

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