annotate liboctave/numeric/eigs-base.cc @ 21136:7cac4e7458f2

maint: clean up code around calls to current_liboctave_error_handler. Remove statements after call to handler that are no longer reachable. Place input validation first and immediately call handler if necessary. Change if/error_handler/else to if/error_handler and re-indent code. * Array-util.cc, Array.cc, CColVector.cc, CDiagMatrix.cc, CMatrix.cc, CNDArray.cc, CRowVector.cc, CSparse.cc, DiagArray2.cc, MArray.cc, PermMatrix.cc, Sparse.cc, Sparse.h, chMatrix.cc, chNDArray.cc, dColVector.cc, dDiagMatrix.cc, dMatrix.cc, dNDArray.cc, dRowVector.cc, dSparse.cc, fCColVector.cc, fCDiagMatrix.cc, fCMatrix.cc, fCNDArray.cc, fCRowVector.cc, fColVector.cc, fDiagMatrix.cc, fMatrix.cc, fNDArray.cc, fRowVector.cc, idx-vector.cc, CmplxAEPBAL.cc, CmplxCHOL.cc, CmplxGEPBAL.cc, CmplxHESS.cc, CmplxLU.cc, CmplxQR.cc, CmplxSCHUR.cc, CmplxSVD.cc, DASPK.cc, EIG.cc, LSODE.cc, Quad.cc, SparseCmplxCHOL.cc, SparseCmplxLU.cc, SparseCmplxQR.cc, SparseQR.cc, SparsedbleCHOL.cc, SparsedbleLU.cc, base-lu.cc, bsxfun-defs.cc, dbleAEPBAL.cc, dbleCHOL.cc, dbleGEPBAL.cc, dbleHESS.cc, dbleLU.cc, dbleQR.cc, dbleSCHUR.cc, dbleSVD.cc, eigs-base.cc, fCmplxAEPBAL.cc, fCmplxCHOL.cc, fCmplxLU.cc, fCmplxQR.cc, fCmplxSCHUR.cc, fEIG.cc, floatAEPBAL.cc, floatCHOL.cc, floatGEPBAL.cc, floatHESS.cc, floatLU.cc, floatQR.cc, floatSCHUR.cc, floatSVD.cc, lo-specfun.cc, oct-fftw.cc, oct-rand.cc, oct-spparms.cc, sparse-base-chol.cc, sparse-dmsolve.cc, file-ops.cc, lo-sysdep.cc, mach-info.cc, oct-env.cc, oct-syscalls.cc, cmd-edit.cc, cmd-hist.cc, data-conv.cc, lo-ieee.cc, lo-regexp.cc, oct-base64.cc, oct-shlib.cc, pathsearch.cc, singleton-cleanup.cc, sparse-util.cc, unwind-prot.cc: Remove statements after call to handler that are no longer reachable. Place input validation first and immediately call handler if necessary. Change if/error_handler/else to if/error_handler and re-indent code.
author Rik <rik@octave.org>
date Sat, 23 Jan 2016 13:52:03 -0800
parents 1edf15793cac
children 538b57866b90
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1 /*
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2
19697
4197fc428c7d maint: Update copyright notices for 2015.
John W. Eaton <jwe@octave.org>
parents: 19410
diff changeset
3 Copyright (C) 2005-2015 David Bateman
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
4
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
5 This file is part of Octave.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
6
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
7 Octave is free software; you can redistribute it and/or modify it
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
9 Free Software Foundation; either version 3 of the License, or (at your
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
10 option) any later version.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
11
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
12 Octave is distributed in the hope that it will be useful, but WITHOUT
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
15 for more details.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
16
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
18 along with Octave; see the file COPYING. If not, see
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
19 <http://www.gnu.org/licenses/>.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
20
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
21 */
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
22
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
23 #ifdef HAVE_CONFIG_H
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
24 #include <config.h>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
25 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
26
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
27 #include <cfloat>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
28 #include <cmath>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
29 #include <vector>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
30 #include <iostream>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
31
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
32 #include "f77-fcn.h"
19269
65554f5847ac don't include oct-locbuf.h in header files unnecessarily
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
33 #include "oct-locbuf.h"
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
34 #include "quit.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
35 #include "SparsedbleLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
36 #include "SparseCmplxLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
37 #include "dSparse.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
38 #include "CSparse.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
39 #include "MatrixType.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
40 #include "SparsedbleCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
41 #include "SparseCmplxCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
42 #include "oct-rand.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
43 #include "dbleCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
44 #include "CmplxCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
45 #include "dbleLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
46 #include "CmplxLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
47
14144
834df9f10963 remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
48 #ifdef HAVE_ARPACK
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
49 typedef ColumnVector (*EigsFunc) (const ColumnVector &x, int &eigs_error);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
50 typedef ComplexColumnVector (*EigsComplexFunc)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
51 (const ComplexColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
52
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
53 // Arpack and blas fortran functions we call.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
54 extern "C"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
55 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
56 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
57 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
58 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
59 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
60 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
61 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
62 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
63 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
64 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
65 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
66 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
67 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
68
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
69 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
70 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&,
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 octave_idx_type*, double*, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
73 const octave_idx_type&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
74 F77_CONST_CHAR_ARG_DECL,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
75 const octave_idx_type&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
76 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
77 const octave_idx_type&, const double&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
78 const octave_idx_type&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
79 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
80 octave_idx_type*, double*, double*,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
81 const octave_idx_type&, octave_idx_type&
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
82 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
83 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
84 F77_CHAR_ARG_LEN_DECL);
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
85
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
86 F77_RET_T
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
87 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
88 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
89 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
90 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
91 octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
92 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
93 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
94 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
95 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
96 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
97 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
98
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
99 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
100 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
101 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
102 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
103 double*, const octave_idx_type&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
104 const double&, double*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
105 F77_CONST_CHAR_ARG_DECL,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
106 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
107 F77_CONST_CHAR_ARG_DECL,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
108 octave_idx_type&, const double&, double*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
109 const octave_idx_type&, double*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
110 const octave_idx_type&, octave_idx_type*,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
111 octave_idx_type*, double*, double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
112 const octave_idx_type&, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
113 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
114 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
115 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
116
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
117 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
118 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
119 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
120 const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
121 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
122 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
123 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
124 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
125 octave_idx_type*, Complex*, Complex*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
126 const octave_idx_type&, double *, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
127 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
128 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
129
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
130 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
131 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
132 F77_CONST_CHAR_ARG_DECL,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
133 octave_idx_type*, Complex*, Complex*,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
134 const octave_idx_type&, const Complex&, Complex*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
135 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
136 const octave_idx_type&,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
137 F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
138 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
139 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
140 const octave_idx_type&, octave_idx_type*,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
141 octave_idx_type*, Complex*, Complex*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
142 const octave_idx_type&, double *, octave_idx_type&
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
143 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
144 F77_CHAR_ARG_LEN_DECL
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
145 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
146
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
147 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
148 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
149 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
150 const double&, const double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 10466
diff changeset
151 const octave_idx_type&, const double*,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
152 const octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
153 const octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
154 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
155
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
156
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
157 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
158 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
159 const octave_idx_type&, const octave_idx_type&,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
160 const Complex&, const Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
161 const octave_idx_type&, const Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
162 const octave_idx_type&, const Complex&, Complex*,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
163 const octave_idx_type&
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
164 F77_CHAR_ARG_LEN_DECL);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
165
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
166 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
167
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
168
20791
f7084eae3318 maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents: 20232
diff changeset
169 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
170 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
171 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
172
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
173 static octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
174 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
175 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
176
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
177 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
178 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
179
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
180 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
181 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
182
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
183 static ComplexMatrix
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
184 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
185 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
186
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
187 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
188 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
189
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
190 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
191 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
192
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
193 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
194 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
195
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
196 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
197 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
198
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
199 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
200 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
201
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
202 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
203 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
204
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
205 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
206 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
207
12202
dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents: 12198
diff changeset
208 #endif
dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK
John W. Eaton <jwe@octave.org>
parents: 12198
diff changeset
209
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
210 static void
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
211 warn_convergence (void)
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
212 {
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
213 (*current_liboctave_warning_with_id_handler)
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
214 ("Octave:convergence",
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
215 "eigs: 'A - sigma*B' is singular, indicating sigma is exactly "
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
216 "an eigenvalue so convergence is not guaranteed");
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
217 }
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
218
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
219 template <class M, class SM>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
220 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
221 lusolve (const SM& L, const SM& U, M& m)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
222 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
223 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
224 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
225 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
226
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
227 // Sparse L is lower triangular, Dense L is permuted lower triangular!!!
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
228 m = L.solve (m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
229 if (err)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
230 return err;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
231
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
232 m = U.solve (utyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
233
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
234 return err;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
235 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
236
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
237 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
238 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
239 ltsolve (const SM& L, const ColumnVector& Q, const M& m)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
240 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
241 octave_idx_type n = L.cols ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
242 octave_idx_type b_nc = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
243 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
244 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
245 MatrixType ltyp (MatrixType::Lower);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
246 M tmp = L.solve (ltyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
247 M retval;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
248 const double* qv = Q.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
249
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
250 if (! err)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
251 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
252 retval.resize (n, b_nc);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
253 for (octave_idx_type j = 0; j < b_nc; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
254 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
255 for (octave_idx_type i = 0; i < n; i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
256 retval.elem (static_cast<octave_idx_type>(qv[i]), j) =
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
257 tmp.elem (i,j);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
258 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
259 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
260
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
261 return retval;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
262 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
263
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
264 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
265 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
266 utsolve (const SM& U, const ColumnVector& Q, const M& m)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
267 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
268 octave_idx_type n = U.cols ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
269 octave_idx_type b_nc = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
270 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
271 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
272 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
273
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
274 M retval (n, b_nc);
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
275 const double* qv = Q.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
276 for (octave_idx_type j = 0; j < b_nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
277 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
278 for (octave_idx_type i = 0; i < n; i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
279 retval.elem (i,j) = m.elem (static_cast<octave_idx_type>(qv[i]), j);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
280 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
281 return U.solve (utyp, retval, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
282 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
283
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
284 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
285 vector_product (const SparseMatrix& m, const double* x, double* y)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
286 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
287 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
288
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
289 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
290 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
291
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
292 for (octave_idx_type j = 0; j < nc; j++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
293 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
294 y[m.ridx (i)] += m.data (i) * x[j];
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
295
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
296 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
297 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
298
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
299 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
300 vector_product (const Matrix& m, const double *x, double *y)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
301 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
302 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
303 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
304
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
305 F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 ("N", 1),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
306 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
307 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
308 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
309
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
310 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
311 (*current_liboctave_error_handler) ("eigs: unrecoverable error in dgemv");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
312
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
313 return true;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
314 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
315
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
316 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
317 vector_product (const SparseComplexMatrix& m, const Complex* x,
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
318 Complex* y)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
319 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
320 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
321
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
322 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
323 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
324
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
325 for (octave_idx_type j = 0; j < nc; j++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
326 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
327 y[m.ridx (i)] += m.data (i) * x[j];
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
328
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
329 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
330 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
331
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
332 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
333 vector_product (const ComplexMatrix& m, const Complex *x, Complex *y)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
334 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
335 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
336 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
337
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
338 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("N", 1),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
339 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
340 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
341 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
342
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
343 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
344 (*current_liboctave_error_handler) ("eigs: unrecoverable error in zgemv");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
345
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
346 return true;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
347 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
348
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
349 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
350 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
351 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
352 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
353 CHOL fact (b, info);
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
354 octave_idx_type n = b.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
355
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
356 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
357 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
358 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
359 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
360 bt = fact.chol_matrix ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
361 b = bt.transpose ();
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
362 permB = ColumnVector (n);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
363 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
364 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
365 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
366 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
367 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
368
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
369 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
370 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
371 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
372 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
373 SparseCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
374
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
375 if (fact.P () != 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
376 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
377 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
378 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
379 b = fact.L ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
380 bt = b.transpose ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
381 permB = fact.perm () - 1.0;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
382 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
383 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
384 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
385
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
386 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
387 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
388 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
389 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
390 ComplexCHOL fact (b, info);
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
391 octave_idx_type n = b.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
392
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
393 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
394 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
395 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
396 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
397 bt = fact.chol_matrix ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
398 b = bt.hermitian ();
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
399 permB = ColumnVector (n);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
400 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
401 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
402 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
403 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
404 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
405
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
406 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
407 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
408 ColumnVector& permB)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
409 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
410 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
411 SparseComplexCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
412
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
413 if (fact.P () != 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
414 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
415 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
416 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
417 b = fact.L ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
418 bt = b.hermitian ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
419 permB = fact.perm () - 1.0;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
420 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
421 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
422 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
423
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
424 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
425 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
426 bool cholB, const ColumnVector& permB, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
427 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
428 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
429 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
430 bool have_b = ! b.is_empty ();
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
431 octave_idx_type n = m.rows ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
432
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
433 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
434 SparseMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
435
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
436 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
437 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
438 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
439 {
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
440 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
441 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
442 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
443 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
444 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
445 tmp.xcidx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
446 tmp.xridx (i) =
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
447 static_cast<octave_idx_type>(permB(i));
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
448 tmp.xdata (i) = 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
449 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
450 tmp.xcidx (n) = n;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
451
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
452 AminusSigmaB -= sigma * tmp *
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
453 b.transpose () * b * tmp.transpose ();
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
454 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
455 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
456 AminusSigmaB -= sigma * b.transpose () * b;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
457 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
458 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
459 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
460 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
461 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
462 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
463 SparseMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
464
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
465 // Create sigma * speye (n,n)
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
466 sigmat.xcidx (0) = 0;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
467 for (octave_idx_type i = 0; i < n; i++)
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
468 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
469 sigmat.xdata (i) = sigma;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
470 sigmat.xridx (i) = i;
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
471 sigmat.xcidx (i+1) = i + 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
472 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
473
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
474 AminusSigmaB -= sigmat;
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
475 }
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
476
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
477 SparseLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
478
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
479 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
480 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
481 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
482 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
483
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
484 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
485 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
486 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
487 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
488 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
489
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
490 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
491 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
492 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
493 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
494 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
495 double d = 0.;
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
496 if (U.xcidx (j+1) > U.xcidx (j)
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
497 && U.xridx (U.xcidx (j+1)-1) == j)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
498 d = std::abs (U.xdata (U.xcidx (j+1)-1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
499
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
500 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
501 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
502
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
503 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
504 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
505 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
506
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
507 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
508 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
509
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
510 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
511 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
512
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
513 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
514 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
515
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
516 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
517 LuAminusSigmaB (const Matrix &m, const Matrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
518 bool cholB, const ColumnVector& permB, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
519 Matrix &L, Matrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
520 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
521 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
522 bool have_b = ! b.is_empty ();
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
523 octave_idx_type n = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
524
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
525 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
526 Matrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
527
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
528 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
529 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
530 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
531 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
532 Matrix tmp = sigma * b.transpose () * b;
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
533 const double *pB = permB.fortran_vec ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
534 double *p = AminusSigmaB.fortran_vec ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
535
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
536 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
537 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
538 for (octave_idx_type j = 0;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
539 j < b.cols (); j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
540 for (octave_idx_type i = 0;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
541 i < b.rows (); i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
542 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]),
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
543 static_cast<octave_idx_type>(pB[j]));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
544 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
545 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
546 AminusSigmaB -= tmp;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
547 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
548 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
549 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
550 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
551 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
552 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
553 double *p = AminusSigmaB.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
554
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
555 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
556 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
557 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
558
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
559 LU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
560
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
561 L = fact.P ().transpose () * fact.L ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
562 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
563 for (octave_idx_type j = 0; j < n; j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
564 P[j] = Q[j] = j;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
565
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
566 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
567 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
568 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
569 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
570 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
571 double d = std::abs (U.xelem (j,j));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
572 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
573 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
574
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
575 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
576 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
577 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
578
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
579 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
580 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
581
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
582 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
583 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
584
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
585 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
586 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
587
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
588 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
589 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
590 bool cholB, const ColumnVector& permB, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
591 SparseComplexMatrix &L, SparseComplexMatrix &U,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
592 octave_idx_type *P, octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
593 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
594 bool have_b = ! b.is_empty ();
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
595 octave_idx_type n = m.rows ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
596
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
597 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
598 SparseComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
599
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
600 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
601 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
602 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
603 {
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
604 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
605 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
606 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
607 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
608 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
609 tmp.xcidx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
610 tmp.xridx (i) =
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
611 static_cast<octave_idx_type>(permB(i));
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
612 tmp.xdata (i) = 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
613 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
614 tmp.xcidx (n) = n;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
615
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
616 AminusSigmaB -= tmp * b.hermitian () * b *
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
617 tmp.transpose () * sigma;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
618 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
619 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
620 AminusSigmaB -= sigma * b.hermitian () * b;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
621 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
622 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
623 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
624 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
625 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
626 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
627 SparseComplexMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
628
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
629 // Create sigma * speye (n,n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
630 sigmat.xcidx (0) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
631 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
632 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
633 sigmat.xdata (i) = sigma;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
634 sigmat.xridx (i) = i;
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
635 sigmat.xcidx (i+1) = i + 1;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
636 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
637
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
638 AminusSigmaB -= sigmat;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
639 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
640
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
641 SparseComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
642
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
643 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
644 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
645 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
646 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
647
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
648 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
649 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
650 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
651 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
652 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
653
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
654 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
655 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
656 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
657 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
658 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
659 double d = 0.;
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
660 if (U.xcidx (j+1) > U.xcidx (j)
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
661 && U.xridx (U.xcidx (j+1)-1) == j)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
662 d = std::abs (U.xdata (U.xcidx (j+1)-1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
663
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
664 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
665 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
666
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
667 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
668 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
669 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
670
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
671 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
672 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
673
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
674 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
675 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
676
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
677 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
678 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
679
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
680 static bool
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
681 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
682 bool cholB, const ColumnVector& permB, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
683 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
684 octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
685 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
686 bool have_b = ! b.is_empty ();
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
687 octave_idx_type n = m.cols ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
688
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
689 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
690 ComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
691
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
692 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
693 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
694 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
695 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
696 ComplexMatrix tmp = sigma * b.hermitian () * b;
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
697 const double *pB = permB.fortran_vec ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
698 Complex *p = AminusSigmaB.fortran_vec ();
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
699
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
700 if (permB.numel ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
701 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
702 for (octave_idx_type j = 0;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
703 j < b.cols (); j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
704 for (octave_idx_type i = 0;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
705 i < b.rows (); i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
706 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]),
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
707 static_cast<octave_idx_type>(pB[j]));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
708 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
709 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
710 AminusSigmaB -= tmp;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
711 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
712 else
20230
e914b5399c67 Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents: 19864
diff changeset
713 AminusSigmaB -= sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
714 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
715 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
716 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
717 Complex *p = AminusSigmaB.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
718
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
719 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
720 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
721 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
722
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
723 ComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
724
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
725 L = fact.P ().transpose () * fact.L ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
726 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
727 for (octave_idx_type j = 0; j < n; j++)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
728 P[j] = Q[j] = j;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
729
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
730 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
731 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
732 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
733 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
734 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
735 double d = std::abs (U.xelem (j,j));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
736 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
737 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
738
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
739 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
740 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
741 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
742
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
743 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
744 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
745
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
746 if (rcond_plus_one == 1.0 || xisnan (rcond))
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19269
diff changeset
747 warn_convergence ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
748
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
749 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
750 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
751
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
752 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
753 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
754 EigsRealSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
755 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
756 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
757 ColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
758 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
759 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
760 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
761 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
762 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
763 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
764 octave_idx_type mode = 1;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
765 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
766 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
767 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
768 double sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
769 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
770
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
771 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
772 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
773 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
774 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
775 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
776
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
777 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
778 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
779 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
780 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
781 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
782 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
783 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
784
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
785 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
786 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
787
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
788 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
789 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
790 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
791
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
792 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
793 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
794
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
795 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
796 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
797 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
798
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
799 if (k < 1 || k > n - 2)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
800 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
801 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
802 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
803
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
804 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
805 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
806 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
807
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
808 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
809 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
810 // Check the we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
811 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
812 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
813
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
814 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
815 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
816 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
817 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
818
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
819 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
820 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
821 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
822 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
823
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
824 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
825 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
826 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
827 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
828
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
829 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
830 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
831 ("eigs: invalid sigma value for real symmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
832
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
833 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
834 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
835 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
836 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
837 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
838 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
839 bt = b;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
840 b = b.transpose ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
841 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
842 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
843 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
844 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
845 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
846 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
847 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
848 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
849 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
850 if (! make_cholb (b, bt, permB))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
851 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
852 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
853 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
854 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
855
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
856 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
857 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
858
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
859 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
860 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
861 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
862 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
863 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
864 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
865 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
866 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
867 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
868 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
869 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
870 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
871
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
872 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
873 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
874
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
875 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
876 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
877 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
878
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
879 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
880 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
881 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
882 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
883
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
884 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
885 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
886 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
887 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
888 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
889 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
890 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
891 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
892
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
893 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
894 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
895 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
896
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
897 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
898 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
899 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
900 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
901 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
902 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
903 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
904 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
905 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
906 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
907
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
908 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
909 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
910 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
911 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
912 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
913 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
914 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
915 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
916
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
917 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
918 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
919 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
920 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
921 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
922 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
923 mtmp(i,0) = workd[i + iptr(0) - 1];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
924
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
925 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
926
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
927 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
928 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
929 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
930 else if (! vector_product (m, workd + iptr(0) - 1,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
931 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
932 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
933 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
934 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
935 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
936 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
937 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
938 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
939
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
940 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
941 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
942 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
943 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
944
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
945 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
946
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
947 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
948 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
949 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
950 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
951 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
952 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
953 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
954 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
955 octave_idx_type *sel = s.fortran_vec ();
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
956
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
957 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
958 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
959
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
960 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
961 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
962
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
963 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
964 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
965 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
966 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
967 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
968 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
969
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
970 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
971 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
972 ("eigs: unrecoverable exception encountered in dseupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
973
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
974 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
975 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
976 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
977 if (typ != "SM" && typ != "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
978 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
979 for (octave_idx_type i = 0; i < k2; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
980 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
981 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
982 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
983 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
984 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
985 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
986
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
987 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
988 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
989 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
990 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
991 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
992
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
993 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
994 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
995 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
996 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
997
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
998 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
999 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1000
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1001 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1002 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1003
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1004 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1005 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1006
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1007 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1008 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1009 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1010 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1011
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1012 if (note3)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1013 eig_vec = ltsolve (b, permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1014 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1015 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1016 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1017 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1018
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1019 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1020 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1021
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1022 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1023 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1024 EigsRealSymmetricMatrixShift (const M& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1025 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1026 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1027 ColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1028 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1029 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1030 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1031 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1032 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1033 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1034 octave_idx_type mode = 3;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1035 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1036 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1037
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1038 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1039 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1040 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1041 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1042 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1043
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1044 // FIXME: The "SM" type for mode 1 seems unstable though faster!!
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1045 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1046 // return EigsRealSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1047 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1048 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1049
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1050 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1051 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1052 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1053 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1054 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1055 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1056 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1057
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1058 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1059 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1060
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1061 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1062 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1063 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1064 " Use 'eig (full (A))' instead");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1065
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1066 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1067 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1068 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1069
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1070 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1071 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1072
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1073 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1074 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1075 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1076
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1077 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1078 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1079 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1080
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1081 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1082 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1083 // Check the we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
1084 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1085 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1086
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1087 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1088 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1089 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1090 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1091
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1092 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1093 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1094 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1095 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1096
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1097 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1098 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1099 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1100
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1101 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1102 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1103
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1104 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1105 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1106 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1107 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1108 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1109 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1110 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1111 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1112 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1113 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1114 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1115 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1116
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1117 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1118 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1119
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1120 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1121 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1122 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1123
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1124 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ()));
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1125 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ()));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1126
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1127 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q))
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1128 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1129
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1130 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1131
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1132 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1133 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1134 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1135 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1136
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1137 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1138 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1139 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1140 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1141 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1142 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1143 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1144 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1145
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1146 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1147 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1148 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1149
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1150 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1151 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1152 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1153 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1154 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1155 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1156 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1157 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1158 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1159 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1160
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1161 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1162 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1163 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1164 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1165 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1166 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1167 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1168 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1169
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1170 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1171 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1172 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1173 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1174 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1175 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1176 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1177
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1178 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1179
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1180 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1181
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1182 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1183 tmp(i,0) = dtmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1184
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1185 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1186
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1187 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1188 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1189 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1190 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1191 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1192 vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1193 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1194 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1195 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1196 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1197
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1198 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1199 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1200
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1201 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1202
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1203 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1204 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1205 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1206 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1207 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1208 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1209 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1210 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1211 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1212 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1213 workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1214 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1215 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1216 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1217 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1218 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1219
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1220 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1221 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1222
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1223 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1224
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1225 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1226 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1227 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1228 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1229 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1230 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1231 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1232 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1233 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1234 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1235 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1236
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1237 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1238 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1239 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1240 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1241
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1242 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1243
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1244 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1245 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1246 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1247 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1248 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1249 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1250 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1251 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1252 octave_idx_type *sel = s.fortran_vec ();
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1253
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1254 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1255 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1256
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1257 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1258 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1259
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1260 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1261 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1262 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1263 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1264 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1265 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1266
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1267 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1268 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1269 ("eigs: unrecoverable exception encountered in dseupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1270
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1271 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1272 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1273 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1274 for (octave_idx_type i = 0; i < k2; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1275 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1276 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1277 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1278 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1279 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1280
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1281 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1282 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1283 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1284
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1285 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1286 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1287 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1288 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1289
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1290 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1291 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1292
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1293 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1294 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1295
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1296 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1297 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1298
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1299 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1300 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1301 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1302 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1303 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1304 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1305 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1306
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1307 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1308 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1309
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1310 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1311 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1312 const std::string &_typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1313 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1314 octave_idx_type &info, Matrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1315 ColumnVector &eig_val, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
1316 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1317 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1318 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1319 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1320 bool have_sigma = (sigma ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1321 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1322 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1323 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1324
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1325 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1326 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1327 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1328 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1329 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1330 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1331 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1332
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1333 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1334 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1335
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1336 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1337 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1338 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1339
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1340 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1341 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1342
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1343 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1344 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1345 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1346
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1347 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1348 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1349 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1350 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1351
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1352 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1353 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1354 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1355
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1356 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1357 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1358 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1359 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1360 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1361 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1362
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1363 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1364 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1365 ("eigs: invalid sigma value for real symmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1366
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1367 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1368 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1369 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1370 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1371 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1372 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1373 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1374 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1375 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1376 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1377 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1378 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1379 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1380 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1381
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1382 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1383 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1384
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1385 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1386 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1387 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1388 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1389 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1390 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1391 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1392 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1393 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1394 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1395 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1396 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1397
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1398 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1399 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1400
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1401 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1402 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1403 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1404
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1405 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1406 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1407 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1408 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1409
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1410 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1411 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1412 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1413 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1414 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1415 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1416 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1417 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1418
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1419 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1420 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1421 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1422
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1423 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1424 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1425 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1426 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1427 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1428 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1429 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1430 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1431 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1432 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1433
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1434 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1435 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1436 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1437 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1438 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1439 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1440 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1441 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1442
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1443
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1444 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1445 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1446 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1447 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1448
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1449 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1450 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1451
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1452 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1453
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1454 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1455 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1456
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1457 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1458 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1459 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1460 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1461 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1462 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1463 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1464 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1465 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1466
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1467 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1468 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1469 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1470 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1471
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1472 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1473
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1474 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1475 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1476 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1477 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1478 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1479 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1480 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1481 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1482 octave_idx_type *sel = s.fortran_vec ();
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1483
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1484 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1485 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1486
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1487 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1488 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1489
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1490 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1491 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1492 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1493 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1494 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1495 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1496
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1497 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1498 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1499 ("eigs: unrecoverable exception encountered in dseupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1500
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1501 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1502 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1503 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1504 if (typ != "SM" && typ != "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1505 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1506 for (octave_idx_type i = 0; i < k2; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1507 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1508 double dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1509 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1510 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1511 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1512 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1513
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1514 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1515 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1516 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1517 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1518 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1519
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1520 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1521 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1522 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1523 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1524
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1525 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1526 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1527
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1528 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1529 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1530
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1531 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1532 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1533
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1534 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1535 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1536 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1537 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1538 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1539 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1540 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1541 (*current_liboctave_error_handler) ("eigs: error %d in dseupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1542
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1543 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1544 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1545
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1546 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1547 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1548 EigsRealNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1549 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1550 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1551 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1552 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1553 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1554 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1555 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1556 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1557 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1558 octave_idx_type mode = 1;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1559 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1560 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1561 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1562 double sigmar = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1563 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1564 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1565
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1566 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1567 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1568 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1569 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1570 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1571
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1572 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1573 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1574 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1575 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1576 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1577 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1578 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1579
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1580 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1581 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1582
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1583 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1584 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1585 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1586
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1587 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1588 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1589
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1590 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1591 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1592 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1593
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1594 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1595 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1596 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1597 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1598
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1599 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1600 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1601 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1602
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1603 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1604 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1605 // Check the we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
1606 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1607 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1608
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1609 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1610 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1611 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1612 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1613
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1614 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1615 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1616 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1617 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1618
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1619 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1620 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
1621 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1622 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1623
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1624 if (typ == "LA" || typ == "SA" || typ == "BE")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1625 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1626 ("eigs: invalid sigma value for unsymmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1627
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1628 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1629 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1630 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1631 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1632 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1633 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1634 bt = b;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1635 b = b.transpose ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1636 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1637 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1638 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1639 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1640 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1641 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1642 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1643 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1644 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1645 if (! make_cholb (b, bt, permB))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1646 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1647 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1648 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1649 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1650
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1651 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1652 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1653
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1654 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1655 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1656 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1657 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1658 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1659 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1660 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1661 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1662 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1663 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1664 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1665 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1666
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1667 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1668 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1669
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1670 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1671 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1672 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1673
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1674 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1675 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1676 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1677 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1678
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1679 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1680 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1681 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1682 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1683 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1684 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1685 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1686 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1687
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1688 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1689 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1690 ("eigs: unrecoverable exception encountered in dnaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1691
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1692 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1693 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1694 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1695 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1696 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1697 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1698 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1699 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1700 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1701 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1702
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1703 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1704 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1705 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1706 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1707 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1708 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1709 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1710 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1711
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1712 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1713 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1714 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1715 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1716 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1717 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1718 mtmp(i,0) = workd[i + iptr(0) - 1];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1719
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1720 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1721
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1722 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1723 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1724 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1725 else if (! vector_product (m, workd + iptr(0) - 1,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1726 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1727 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1728 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1729 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1730 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1731 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1732 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1733 ("eigs: error %d in dnaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1734
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1735 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1736 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1737 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1738 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1739
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1740 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1741
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1742 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1743 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1744 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1745 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1746 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1747 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1748 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1749 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1750 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1751
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1752 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip
12198
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1753 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1754 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1755 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1756 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1757 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1758
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
1759 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1760 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1761
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1762 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1763 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1764 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1765 for (octave_idx_type i = 0; i < k+1; i++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1766 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1767
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1768 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1769 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1770 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1771 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1772 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1773 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1774
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1775 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1776 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1777 ("eigs: unrecoverable exception encountered in dneupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1778
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1779 eig_val.resize (k+1);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1780 Complex *d = eig_val.fortran_vec ();
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1781
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1782 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1783 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1784 octave_idx_type jj = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1785 for (octave_idx_type i = 0; i < k+1; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1786 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1787 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1788 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1789 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1790 d[i-jj] = Complex (dr[i], di[i]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1791 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1792 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1793 for (octave_idx_type i = 0; i < k; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1794 d[i] = d[i+1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1795
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1796 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1797 for (octave_idx_type i = 0; i < k2; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1798 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1799 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1800 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1801 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1802 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1803 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1804
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1805 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1806 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1807 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1808
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1809 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1810 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1811 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1812 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1813
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1814 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1815 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1816
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1817 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1818 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1819
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1820 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1821 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1822
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1823 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1824 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1825 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1826
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1827 eig_vec.resize (n, k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1828 octave_idx_type i = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1829 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1830 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1831 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1832 octave_idx_type off2 = (i+1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1833 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1834 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1835 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1836 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1837 Complex (z[j+off1],0.);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1838 i++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1839 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1840 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1841 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1842 for (octave_idx_type j = 0; j < n; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1843 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1844 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1845 Complex (z[j+off1],z[j+off2]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1846 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1847 eig_vec(j,i+1) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1848 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1849 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1850 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1851 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1852 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1853
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1854 if (note3)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1855 eig_vec = ltsolve (M(b), permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1856 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1857 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1858 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1859 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1860
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1861 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1862 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1863
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1864 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1865 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1866 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1867 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1868 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1869 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1870 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1871 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1872 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1873 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1874 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1875 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1876 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1877 octave_idx_type mode = 3;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1878 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1879 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1880 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1881
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1882 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1883 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1884 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1885 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1886 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1887
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1888 // FIXME: The "SM" type for mode 1 seems unstable though faster!!
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1889 //if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1890 // return EigsRealNonSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1891 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1892 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1893
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1894 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1895 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1896 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1897 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1898 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1899 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1900 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1901
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1902 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1903 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1904
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1905 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1906 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1907 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1908
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1909 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1910 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1911
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1912 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1913 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1914 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1915
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1916 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1917 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1918 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1919 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1920
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1921 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1922 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1923 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1924
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
1925 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1926 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1927 // Check that we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
1928 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1929 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1930
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1931 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1932 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1933 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1934 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1935
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1936 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1937 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1938 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1939 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1940
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1941 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1942 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1943 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1944
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1945 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1946 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1947
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1948 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1949 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1950 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1951 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1952 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1953 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1954 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1955 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1956 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1957 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1958 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1959 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1960
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1961 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1962 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1963
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1964 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1965 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1966 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1967
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1968 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ()));
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1969 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ()));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1970
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
1971 if (! LuAminusSigmaB (m, b, cholB, permB, sigmar, L, U, P, Q))
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1972 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1973
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1974 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1975
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1976 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1977 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1978 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1979 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1980
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1981 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1982 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1983 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1984 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
1985 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1986 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1987 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1988 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1989
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1990 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1991 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
1992 ("eigs: unrecoverable exception encountered in dsaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1993
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
1994 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1995 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1996 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1997 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1998 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1999 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2000 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2001 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2002 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2003 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2004
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2005 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2006 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2007 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2008 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2009 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2010 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2011 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2012 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2013
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2014 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2015 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2016 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2017 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2018 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2019 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2020 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2021
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2022 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2023
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2024 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2025
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2026 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2027 tmp(i,0) = dtmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2028
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2029 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2030
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2031 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2032 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2033 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2034 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2035 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2036 vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2037 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2038 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2039 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2040 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2041
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2042 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2043 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2044
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2045 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2046
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2047 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2048 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2049 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2050 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2051 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2052 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2053 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2054 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2055 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2056 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2057 workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2058 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2059 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2060 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2061 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2062 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2063
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2064 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2065 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2066
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2067 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2068
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2069 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2070 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2071 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2072 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2073 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2074 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2075 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2076 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2077 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2078 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2079 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2080
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2081 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2082 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2083 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2084 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2085
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2086 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2087
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2088 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2089 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2090 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2091 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2092 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2093 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2094 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2095 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2096 octave_idx_type *sel = s.fortran_vec ();
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2097
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2098 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip
12198
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2099 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2100 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2101 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2102 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2103 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2104
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2105 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2106 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2107
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2108 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2109 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2110 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2111 for (octave_idx_type i = 0; i < k+1; i++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2112 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2113
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2114 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2115 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2116 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2117 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2118 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2119 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2120
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2121 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2122 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2123 ("eigs: unrecoverable exception encountered in dneupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2124
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2125 eig_val.resize (k+1);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2126 Complex *d = eig_val.fortran_vec ();
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2127
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2128 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2129 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2130 octave_idx_type jj = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2131 for (octave_idx_type i = 0; i < k+1; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2132 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2133 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2134 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2135 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2136 d[i-jj] = Complex (dr[i], di[i]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2137 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2138 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2139 for (octave_idx_type i = 0; i < k; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2140 d[i] = d[i+1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2141
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2142 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2143 for (octave_idx_type i = 0; i < k2; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2144 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2145 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2146 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2147 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2148 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2149 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2150
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2151 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2152 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2153 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2154
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2155 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2156 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2157 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2158 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2159
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2160 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2161 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2162
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2163 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2164 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2165
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2166 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2167 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2168
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2169 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2170 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2171 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2172
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2173 eig_vec.resize (n, k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2174 octave_idx_type i = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2175 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2176 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2177 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2178 octave_idx_type off2 = (i+1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2179 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2180 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2181 for (octave_idx_type j = 0; j < n; j++)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2182 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2183 Complex (z[j+off1],0.);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2184 i++;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2185 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2186 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2187 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2188 for (octave_idx_type j = 0; j < n; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2189 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2190 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2191 Complex (z[j+off1],z[j+off2]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2192 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2193 eig_vec(j,i+1) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2194 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2195 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2196 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2197 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2198 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2199 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2200 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2201 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2202 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2203
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2204 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2205 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2206
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2207 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2208 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2209 const std::string &_typ, double sigmar,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2210 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2211 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2212 ComplexColumnVector &eig_val, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
2213 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2214 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2215 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2216 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2217 bool have_sigma = (sigmar ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2218 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2219 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2220 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2221 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2222
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2223 if (resid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2224 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2225 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2226 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2227 resid = ColumnVector (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2228 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2229 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2230
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2231 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2232 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2233
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2234 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2235 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2236 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2237
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2238 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2239 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2240
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2241 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2242 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2243 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2244
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2245 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2246 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2247 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2248 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2249
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2250 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2251 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2252 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2253
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2254
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2255 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2256 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2257 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2258 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2259 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2260 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2261
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2262 if (typ == "LA" || typ == "SA" || typ == "BE")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2263 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2264 ("eigs: invalid sigma value for unsymmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2265
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2266 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2267 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2268 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2269 sigmar = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2270 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2271 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2272 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2273 else if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2274 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2275 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2276 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2277 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2278 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2279 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2280
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2281 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2282 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2283
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2284 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2285 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2286 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2287 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2288 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2289 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2290 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2291 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2292 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2293 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2294 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2295 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2296
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2297 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2298 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2299
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2300 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2301 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2302 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2303
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2304 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2305 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2306 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2307 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2308
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2309 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2310 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2311 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2312 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2313 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2314 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2315 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2316 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2317
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2318 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2319 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2320 ("eigs: unrecoverable exception encountered in dnaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2321
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2322 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2323 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2324 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2325 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2326 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2327 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2328 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2329 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2330 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2331 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2332
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2333 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2334 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2335 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2336 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2337 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2338 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2339 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2340 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2341
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2342 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2343 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2344 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2345 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2346
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2347 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2348 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2349
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2350 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2351
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2352 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2353 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2354
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2355 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2356 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2357 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2358 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2359 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2360 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2361 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2362 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2363 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2364
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2365 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2366 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2367 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2368 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2369
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2370 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2371
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2372 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2373 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2374 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2375 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2376 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2377 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2378 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2379 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2380 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2381
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2382 // FIXME: initialize eig_vec2 to zero; apparently dneupd can skip
12198
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2383 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2384 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2385 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2386 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2387 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2388
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD
John W. Eaton <jwe@octave.org>
parents: 12195
diff changeset
2389 Matrix eig_vec2 (n, k + 1, 0.0);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2390 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2391
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2392 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2393 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2394 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2395 for (octave_idx_type i = 0; i < k+1; i++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2396 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2397
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2398 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2399 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2400 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2401 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2402 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2403 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2404
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2405 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2406 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2407 ("eigs: unrecoverable exception encountered in dneupd");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2408
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2409 eig_val.resize (k+1);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2410 Complex *d = eig_val.fortran_vec ();
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2411
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2412 if (info2 == 0)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2413 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2414 octave_idx_type jj = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2415 for (octave_idx_type i = 0; i < k+1; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2416 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2417 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2418 jj++;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2419 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2420 d[i-jj] = Complex (dr[i], di[i]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2421 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2422 if (jj == 0 && ! rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2423 for (octave_idx_type i = 0; i < k; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2424 d[i] = d[i+1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2425
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2426 octave_idx_type k2 = k / 2;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2427 for (octave_idx_type i = 0; i < k2; i++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2428 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2429 Complex dtmp = d[i];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2430 d[i] = d[k - i - 1];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2431 d[k - i - 1] = dtmp;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2432 }
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2433 eig_val.resize (k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2434
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2435 if (rvec)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2436 {
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2437 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2438
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2439 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2440 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2441 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2442 octave_idx_type off2 = (k - i - 1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2443
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2444 if (off1 == off2)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2445 continue;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2446
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2447 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2448 dtmp[j] = z[off1 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2449
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2450 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2451 z[off1 + j] = z[off2 + j];
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2452
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2453 for (octave_idx_type j = 0; j < n; j++)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2454 z[off2 + j] = dtmp[j];
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2455 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2456
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2457 eig_vec.resize (n, k);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2458 octave_idx_type i = 0;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2459 while (i < k)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2460 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2461 octave_idx_type off1 = i * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2462 octave_idx_type off2 = (i+1) * n;
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2463 if (std::imag (eig_val(i)) == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2464 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2465 for (octave_idx_type j = 0; j < n; j++)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2466 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2467 Complex (z[j+off1],0.);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2468 i++;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2469 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2470 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2471 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2472 for (octave_idx_type j = 0; j < n; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2473 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2474 eig_vec(j,i) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2475 Complex (z[j+off1],z[j+off2]);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2476 if (i < k - 1)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2477 eig_vec(j,i+1) =
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2478 Complex (z[j+off1],-z[j+off2]);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2479 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2480 i+=2;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2481 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2482 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2483 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2484 }
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2485 else
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2486 (*current_liboctave_error_handler) ("eigs: error %d in dneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2487
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2488 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2489 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2490
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2491 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2492 octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2493 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2494 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2495 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2496 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2497 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2498 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2499 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2500 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2501 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2502 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2503 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2504 octave_idx_type mode = 1;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2505 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2506 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2507 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2508 Complex sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2509 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2510
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2511 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2512 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2513 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2514 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2515 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2516
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2517 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2518 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2519 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2520 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2521 Array<double> rr (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2522 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2523 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2524 for (octave_idx_type i = 0; i < n; i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2525 cresid(i) = Complex (rr(i),ri(i));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2526 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2527 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2528
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2529 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2530 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2531
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2532 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2533 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2534 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2535
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2536 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2537 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2538
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2539 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2540 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2541 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2542
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2543 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2544 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2545 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2546 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2547
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2548 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2549 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2550 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2551
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2552 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2553 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2554 // Check the we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
2555 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2556 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2557
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2558 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2559 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2560 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2561 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2562
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2563 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2564 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2565 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2566 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2567
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2568 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2569 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
2570 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2571 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2572
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2573 if (typ == "LA" || typ == "SA" || typ == "BE")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2574 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2575 ("eigs: invalid sigma value for complex problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2576
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2577 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2578 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2579 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2580 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2581 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2582 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2583 bt = b;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2584 b = b.hermitian ();
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2585 if (permB.is_empty ())
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2586 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2587 permB = ColumnVector (n);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2588 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2589 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2590 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2591 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2592 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2593 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2594 if (! make_cholb (b, bt, permB))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2595 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2596 ("eigs: The matrix B is not positive definite");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2597 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2598 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2599
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2600 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2601 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2602
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2603 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2604 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2605 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2606 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2607 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2608 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2609 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2610 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2611 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2612 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2613 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2614 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2615
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2616 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2617 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2618
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2619 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2620 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2621 octave_idx_type lwork = p * (3 * p + 5);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2622
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2623 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2624 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2625 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2626 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2627 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2628
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2629 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2630 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2631 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2632 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2633 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2634 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2635 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2636 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2637
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2638 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2639 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2640 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2641
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2642 if (disp > 0 && ! xisnan (workl[iptr (5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2643 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2644 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2645 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2646 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2647 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2648 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2649 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2650 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2651 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2652
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2653 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2654 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2655 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2656 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2657 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2658 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2659 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2660 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2661
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2662 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2663 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2664 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2665 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2666 ComplexMatrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2667 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2668 mtmp(i,0) = workd[i + iptr(0) - 1];
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2669 mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2670 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2671 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2672
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2673 }
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2674 else if (! vector_product (m, workd + iptr(0) - 1,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2675 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2676 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2677 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2678 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2679 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2680 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2681 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2682 ("eigs: error %d in znaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2683
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2684 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2685 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2686 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2687 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2688
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2689 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2690
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2691 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2692 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2693 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2694 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2695 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2696 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2697 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2698 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2699 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2700
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2701 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2702 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2703
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2704 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2705 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2706
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2707 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2708
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2709 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2710 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2711 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2712 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2713 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2714 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2715
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2716 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2717 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2718 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2719
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2720 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2721 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2722 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2723 for (octave_idx_type i = 0; i < k2; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2724 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2725 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2726 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2727 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2728 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2729 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2730
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2731 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2732 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2733 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2734
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2735 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2736 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2737 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2738 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2739
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2740 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2741 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2742
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2743 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2744 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2745
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2746 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2747 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2748
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2749 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2750 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2751 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2752
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2753 if (note3)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2754 eig_vec = ltsolve (b, permB, eig_vec);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2755 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2756 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2757 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2758 (*current_liboctave_error_handler) ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2759
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2760 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2761 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2762
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2763 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2764 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2765 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2766 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2767 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2768 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2769 ComplexColumnVector &eig_val, const M& _b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2770 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2771 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2772 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2773 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2774 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2775 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2776 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2777 octave_idx_type mode = 3;
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2778 bool have_b = ! b.is_empty ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2779 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2780
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2781 if (m.rows () != m.cols ())
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2782 (*current_liboctave_error_handler) ("eigs: A must be square");
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2783 if (have_b && (m.rows () != b.rows () || m.rows () != b.cols ()))
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2784 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2785 ("eigs: B must be square and the same size as A");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2786
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2787 // FIXME: The "SM" type for mode 1 seems unstable though faster!!
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2788 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2789 // return EigsComplexNonSymmetricMatrix (m, "SM", k, p, info, eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2790 // eig_val, _b, permB, cresid, os, tol,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2791 // rvec, cholB, disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2792
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2793 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2794 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2795 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2796 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2797 Array<double> rr (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2798 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2799 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2800 for (octave_idx_type i = 0; i < n; i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2801 cresid(i) = Complex (rr(i),ri(i));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2802 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2803 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2804
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2805 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2806 (*current_liboctave_error_handler) ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2807
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2808 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2809 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2810 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2811
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2812 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2813 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2814
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2815 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2816 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2817 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2818
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2819 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2820 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2821 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2822 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2823
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2824 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2825 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2826 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2827
20974
1edf15793cac maint: Use is_empty rather than "numel () == 0" for clarity.
Rik <rik@octave.org>
parents: 20955
diff changeset
2828 if (have_b && cholB && ! permB.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2829 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2830 // Check that we really have a permutation vector
20232
a9574e3c6e9e Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents: 20230
diff changeset
2831 if (permB.numel () != n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2832 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2833
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2834 Array<bool> checked (dim_vector (n, 1), false);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2835 for (octave_idx_type i = 0; i < n; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2836 {
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2837 octave_idx_type bidx = static_cast<octave_idx_type> (permB(i));
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2838
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2839 if (checked(bidx) || bidx < 0 || bidx >= n || D_NINT (bidx) != bidx)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2840 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2841 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2842 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2843
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2844 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2845 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2846 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2847
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2848 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2849 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2850
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2851 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2852 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2853 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2854 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2855 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2856 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2857 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2858 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2859 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2860 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2861 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2862 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2863
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2864 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2865 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2866
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2867 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2868 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2869 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2870
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2871 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows () : m.rows ()));
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2872 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols () : m.cols ()));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2873
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
2874 if (! LuAminusSigmaB (m, b, cholB, permB, sigma, L, U, P, Q))
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2875 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2876
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2877 octave_idx_type lwork = p * (3 * p + 5);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2878
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2879 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2880 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2881 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2882 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2883 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2884
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2885 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2886 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2887 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2888 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
2889 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2890 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2891 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2892 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2893
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2894 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2895 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2896 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2897
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
2898 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2899 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2900 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2901 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2902 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2903 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2904 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2905 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2906 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2907 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2908
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2909 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2910 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2911 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2912 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2913 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2914 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2915 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2916 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2917
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2918 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2919 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2920 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2921 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2922 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2923 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2924 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2925
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2926 vector_product (m, workd+iptr(0)-1, ctmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2927
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2928 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2929
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2930 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2931 tmp(i,0) = ctmp[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2932
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2933 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2934
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2935 Complex *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2936 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2937 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2938 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2939 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2940 vector_product (b, workd + iptr(0) - 1, workd + iptr(1) - 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2941 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2942 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2943 Complex *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2944 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2945
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2946 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2947 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2948
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2949 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2950
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2951 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2952 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2953 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2954 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2955 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2956 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2957 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2958 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2959 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2960 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2961 workd[iptr(0) + i - 1] =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2962 workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2963 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2964 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2965 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2966 Complex *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2967 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2968
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2969 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2970 tmp(i,0) = ip2[P[i]];
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2971
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2972 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2973
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2974 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2975 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2976 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2977 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2978 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2979 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2980 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2981 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2982 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2983 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2984 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
2985
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2986 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2987 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2988 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2989 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2990
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2991 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2992
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2993 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2994 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2995 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2996 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2997 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
2998 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2999 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3000 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3001 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3002
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3003 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3004 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3005
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3006 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3007 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3008
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3009 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3010
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3011 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3012 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3013 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3014 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3015 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3016 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3017
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3018 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3019 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3020 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3021
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3022 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3023 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3024 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3025 for (octave_idx_type i = 0; i < k2; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3026 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3027 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3028 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3029 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3030 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3031 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3032
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3033 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3034 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3035 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3036
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3037 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3038 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3039 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3040 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3041
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3042 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3043 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3044
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3045 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3046 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3047
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3048 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3049 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3050
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3051 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3052 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3053 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3054 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3055 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3056 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3057 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3058 ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3059
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3060 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3061 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3062
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3063 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3064 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3065 const std::string &_typ, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3066 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3067 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3068 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3069 ComplexColumnVector &cresid, std::ostream& os,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3070 double tol, bool rvec, bool /* cholB */,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3071 int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3072 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3073 std::string typ (_typ);
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3074 bool have_sigma = (std::abs (sigma) ? true : false);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3075 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3076 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3077 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3078
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
3079 if (cresid.is_empty ())
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3080 {
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
3081 std::string rand_dist = octave_rand::distribution ();
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3082 octave_rand::distribution ("uniform");
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3083 Array<double> rr (octave_rand::vector (n));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3084 Array<double> ri (octave_rand::vector (n));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3085 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3086 for (octave_idx_type i = 0; i < n; i++)
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3087 cresid(i) = Complex (rr(i),ri(i));
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3088 octave_rand::distribution (rand_dist);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3089 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3090
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3091 if (n < 3)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3092 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3093 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3094
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3095 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3096 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3097 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3098
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3099 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3100 p = 20;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3101
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3102 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3103 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3104 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3105
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3106 if (k <= 0 || k >= n - 1)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3107 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3108 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3109 " Use 'eig (full (A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3110
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3111 if (p <= k || p >= n)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3112 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3113 ("eigs: opts.p must be greater than k and less than n");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3114
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3115 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3116 {
19864
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
3117 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
3118 && typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI"
17d647821d61 maint: More cleanup of C++ code to follow Octave coding conventions.
John W. Eaton <jwe@octave.org>
parents: 19697
diff changeset
3119 && typ != "SI")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3120 (*current_liboctave_error_handler) ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3121
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3122 if (typ == "LA" || typ == "SA" || typ == "BE")
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3123 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3124 ("eigs: invalid sigma value for complex problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3125
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3126 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3127 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3128 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3129 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3130 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3131 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3132 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3133 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3134 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3135 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3136 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3137 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3138 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3139 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3140
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3141 Array<octave_idx_type> ip (dim_vector (11, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3142 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3143
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3144 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3145 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3146 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3147 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3148 ip(4) = 0; // nconv, number of Ritz values that satisfy convergence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3149 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3150 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3151 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3152 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3153 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3154 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3155 // ip(7) to ip(10) return values
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3156
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3157 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3158 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3159
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3160 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3161 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3162 octave_idx_type lwork = p * (3 * p + 5);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3163
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3164 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3165 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3166 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3167 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3168 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3169
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3170 do
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3171 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3172 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3173 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
14846
460a3c6d8bf1 maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents: 14711
diff changeset
3174 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3175 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3176 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3177 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3178
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3179 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3180 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3181 ("eigs: unrecoverable exception encountered in znaupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3182
20955
77f5591878bf maint: Use '! expr' rather than '!expr' to conform to coding guidelines.
Rik <rik@octave.org>
parents: 20791
diff changeset
3183 if (disp > 0 && ! xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3184 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3185 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3186 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3187 os << "Iteration " << iter - 1 <<
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3188 ": a few Ritz values of the " << p << "-by-" <<
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3189 p << " matrix\n";
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3190 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3191 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3192 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3193
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3194 // This is a kludge, as ARPACK doesn't give its
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3195 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3196 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3197 // a value in this array to NaN and testing for it
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3198 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3199 if (ido != 99)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3200 workl[iptr(5)-1] = octave_NaN;
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3201 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3202
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3203 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3204 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3205 Complex *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3206 ComplexColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3207
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3208 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3209 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3210
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3211 ComplexColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3212
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3213 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3214 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3215
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3216 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3217 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3218 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3219 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3220 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3221 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3222 if (info < 0)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3223 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3224 ("eigs: error %d in dsaupd", info);
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3225
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3226 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3227 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3228 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3229 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3230
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3231 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3232
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3233 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3234 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3235 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3236 // per bool, though this might be system dependent. As
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3237 // long as the HOWMNY arg is not "S", the logical array
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3238 // is just workspace for ARPACK, so use int type to
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3239 // avoid problems.
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
3240 Array<octave_idx_type> s (dim_vector (p, 1));
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3241 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3242
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3243 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3244 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3245
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3246 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3247 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3248
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3249 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3250
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3251 F77_FUNC (zneupd, ZNEUPD)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3252 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3253 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3254 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3255 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3256 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3257
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3258 if (f77_exception_encountered)
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3259 (*current_liboctave_error_handler)
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3260 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3261
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3262 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3263 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3264 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3265 for (octave_idx_type i = 0; i < k2; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3266 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3267 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3268 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3269 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3270 }
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14846
diff changeset
3271 eig_val.resize (k);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3272
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3273 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3274 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3275 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3276
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3277 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3278 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3279 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3280 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3281
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3282 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3283 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3284
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3285 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3286 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3287
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3288 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3289 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3290
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3291 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3292 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3293 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3294 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3295 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3296 else
21136
7cac4e7458f2 maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents: 20974
diff changeset
3297 (*current_liboctave_error_handler) ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3298
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3299 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3300 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3301
20791
f7084eae3318 maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents: 20232
diff changeset
3302 #if ! defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3303 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3304 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3305 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3306 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3307 ColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3308 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3309 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3310 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3311 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3312 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3313
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3314 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3315 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3316 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3317 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3318 ColumnVector &eig_val, const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3319 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3320 std::ostream& os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3321 double tol = std::numeric_limits<double>::epsilon (),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3322 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3323 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3324
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3325 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3326 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3327 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3328 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3329 ColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3330 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3331 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3332 double tol = std::numeric_limits<double>::epsilon (),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3333 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3334 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3335
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3336 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3337 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3338 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3339 octave_idx_type &info, Matrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3340 ColumnVector &eig_val, const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3341 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3342 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3343 double tol = std::numeric_limits<double>::epsilon (),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3344 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3345 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3346
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3347 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3348 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3349 const std::string &typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3350 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3351 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3352 Matrix &eig_vec, ColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3353 ColumnVector &resid, std::ostream &os,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3354 double tol = std::numeric_limits<double>::epsilon (),
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3355 bool rvec = false, bool cholB = 0, int disp = 0,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3356 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3357
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3358 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3359 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3360 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3361 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3362 ComplexColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3363 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3364 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3365 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3366 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3367 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3368
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3369 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3370 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3371 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3372 octave_idx_type &info, ComplexMatrix &eig_vec,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3373 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3374 const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3375 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3376 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3377 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3378 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3379 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3380
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3381 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3382 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3383 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3384 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3385 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3386 ComplexColumnVector &eig_val, const Matrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3387 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3388 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3389 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3390 bool rvec = false, bool cholB = 0,
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3391 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3392
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3393 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3394 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3395 octave_idx_type k, octave_idx_type p,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3396 octave_idx_type &info,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3397 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3398 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3399 const SparseMatrix& b,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3400 ColumnVector &permB, ColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3401 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3402 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3403 bool rvec = false, bool cholB = 0,
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3404 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3405
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3406 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3407 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3408 const std::string &_typ, double sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3409 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3410 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3411 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3412 ColumnVector &resid, std::ostream& os,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3413 double tol = std::numeric_limits<double>::epsilon (),
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3414 bool rvec = false, bool cholB = 0, int disp = 0,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3415 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3416
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3417 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3418 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3419 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3420 octave_idx_type &info, ComplexMatrix &eig_vec,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3421 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3422 const ComplexMatrix& b, ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3423 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3424 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3425 double tol = std::numeric_limits<double>::epsilon (),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3426 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3427 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3428
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3429 extern octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3430 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3431 const std::string typ, octave_idx_type k,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3432 octave_idx_type p, octave_idx_type &info,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3433 ComplexMatrix &eig_vec,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3434 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3435 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3436 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3437 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3438 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3439 double tol = std::numeric_limits<double>::epsilon (),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3440 bool rvec = false, bool cholB = 0, int disp = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3441 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3442
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3443 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3444 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3445 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3446 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3447 ComplexMatrix &eig_vec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3448 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3449 const ComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3450 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3451 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3452 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3453 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3454 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3455 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3456
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3457 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3458 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3459 Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3460 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3461 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3462 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3463 ComplexColumnVector &eig_val,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3464 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3465 ColumnVector &permB,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3466 ComplexColumnVector &resid,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3467 std::ostream &os,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3468 double tol = std::numeric_limits<double>::epsilon (),
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3469 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3470 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3471
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3472 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3473 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3474 const std::string &_typ, Complex sigma,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3475 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3476 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3477 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3478 ComplexColumnVector &resid, std::ostream& os,
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3479 double tol = std::numeric_limits<double>::epsilon (),
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3480 bool rvec = false, bool cholB = 0,
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15020
diff changeset
3481 int disp = 0, int maxit = 300);
14144
834df9f10963 remove ARPACK files from sources and restore configure checks for external ARPACK library
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
3482 #endif
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3483
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3484 #ifndef _MSC_VER
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3485 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3486 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3487
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3488 template octave_idx_type
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3489 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3490 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3491
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3492 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3493 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3494
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3495 template octave_idx_type
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3496 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3497
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3498 template ComplexMatrix
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
3499 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3500 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3501
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3502 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3503 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3504
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3505 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3506 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3507
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3508 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3509 ltsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3510
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3511 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3512 utsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3513 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3514
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3515 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3516 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3517
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3518 template ComplexMatrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3519 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3520
14711
f5c3de9502b2 Fix compilation error on newer compilers
Alexander Hansen <alexanderk.hansen@gmail.com>
parents: 14144
diff changeset
3521 template Matrix
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3522 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3523 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3524
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3525 #endif