Mercurial > hg > octave-lyh

annotate liboctave/eigs-base.cc @ 10396:a0b51ac0f88a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
optimize accumdim with summation
author Jaroslav Hajek <highegg@gmail.com>
date Fri, 05 Mar 2010 12:31:30 +0100
parents b4f67ca318d8
children c0c24219fccf
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
8920
eb63fbe60fab update copyright notices
John W. Eaton <jwe@octave.org>
parents: 8677
diff changeset
3 Copyright (C) 2005, 2008, 2009 David Bateman
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
4
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
5 This file is part of Octave.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
6
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
7 Octave is free software; you can redistribute it and/or modify it
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
9 Free Software Foundation; either version 3 of the License, or (at your
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
10 option) any later version.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
11
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
12 Octave is distributed in the hope that it will be useful, but WITHOUT
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
15 for more details.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
16
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
18 along with Octave; see the file COPYING. If not, see
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
19 <http://www.gnu.org/licenses/>.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
20
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
21 */
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
22
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
23 #ifdef HAVE_CONFIG_H
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
24 #include <config.h>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
25 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
26
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
27 #include <cfloat>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
28 #include <cmath>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
29 #include <vector>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
30 #include <iostream>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
31
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
32 #include "f77-fcn.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
33 #include "quit.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
34 #include "SparsedbleLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
35 #include "SparseCmplxLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
36 #include "dSparse.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
37 #include "CSparse.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
38 #include "MatrixType.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
39 #include "SparsedbleCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
40 #include "SparseCmplxCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
41 #include "oct-rand.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
42 #include "dbleCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
43 #include "CmplxCHOL.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
44 #include "dbleLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
45 #include "CmplxLU.h"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
46
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
47 #ifdef HAVE_ARPACK
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
48 typedef ColumnVector (*EigsFunc) (const ColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
49 typedef ComplexColumnVector (*EigsComplexFunc)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
50 (const ComplexColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
51
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
52 // Arpack and blas fortran functions we call.
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
53 extern "C"
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
54 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
55 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
56 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
57 const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
58 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
59 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
60 const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
61 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
62 const octave_idx_type&, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
63 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
64
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
65 F77_RET_T
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
66 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
67 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
68 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
69 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
70 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
71 const double&, double*, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
72 double*, const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
73 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
74 const octave_idx_type&, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
75 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
76 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
77
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
78 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
79 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
80 const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
81 octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
82 double*, const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
83 const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
84 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
85 const octave_idx_type&, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
86 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
87
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
88 F77_RET_T
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
89 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
90 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
91 double*, const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
92 const double&, double*, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
93 const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
94 octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
95 const octave_idx_type&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
96 const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
97 octave_idx_type*, double*, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
98 const octave_idx_type&, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
99 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
100 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
101
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
102 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
103 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
104 const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
105 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
106 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
107 const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
108 octave_idx_type*, Complex*, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
109 const octave_idx_type&, double *, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
110 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
111
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
112 F77_RET_T
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
113 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
114 octave_idx_type*, Complex*, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
115 const octave_idx_type&, const Complex&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
116 Complex*, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
117 const octave_idx_type&, F77_CONST_CHAR_ARG_DECL,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
118 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
119 Complex*, const octave_idx_type&, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
120 const octave_idx_type&, octave_idx_type*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
121 octave_idx_type*, Complex*, Complex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
122 const octave_idx_type&, double *, octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
123 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
124 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
125
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
126 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
127 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
128 const octave_idx_type&, const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
129 const double*, const octave_idx_type&, const double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
130 const octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
131 const octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
132 F77_CHAR_ARG_LEN_DECL);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
133
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
134
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
135 F77_RET_T
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
136 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
137 const octave_idx_type&, const octave_idx_type&, const Complex&,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
138 const Complex*, const octave_idx_type&, const Complex*,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
139 const octave_idx_type&, const Complex&, Complex*, const octave_idx_type&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
140 F77_CHAR_ARG_LEN_DECL);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
141
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
142 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
143
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
144
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
145 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
146 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
147 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
148
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
149 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
150 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
151 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
152
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
153 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
154 lusolve (const Matrix&, const Matrix&, Matrix&);
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 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
157 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
158
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
159 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
160 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
161 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
162
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
163 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
164 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,);
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 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
167 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
168
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
169 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
170 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
171
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
172 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
173 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
174
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
175 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
176 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
177
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
178 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
179 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
180
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
181 static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
182 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
183
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
184 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
185
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
186 template <class M, class SM>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
187 static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
188 lusolve (const SM& L, const SM& U, M& m)
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 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
191 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
192 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
193
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
194 // 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
195 m = L.solve (m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
196 if (err)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
197 return err;
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 m = U.solve (utyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
200
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
201 return err;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
202 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
203
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
204 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
205 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
206 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
207 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
208 octave_idx_type n = L.cols();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
209 octave_idx_type b_nc = m.cols();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
210 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
211 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
212 MatrixType ltyp (MatrixType::Lower);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
213 M tmp = L.solve (ltyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
214 M retval;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
215 const double* qv = Q.fortran_vec();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
216
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
217 if (!err)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
218 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
219 retval.resize (n, b_nc);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
220 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
221 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
222 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
223 retval.elem(static_cast<octave_idx_type>(qv[i]), j) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
224 tmp.elem(i,j);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
225 }
8417
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
228 return retval;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
229 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
230
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
231 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
232 static M
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
233 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
234 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
235 octave_idx_type n = U.cols();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
236 octave_idx_type b_nc = m.cols();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
237 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
238 double rcond;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
239 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
240
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
241 M retval (n, b_nc);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
242 const double* qv = Q.fortran_vec();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
243 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
244 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
245 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
246 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
247 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
248 return U.solve (utyp, retval, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
249 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
250
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
251 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
252 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
253 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
254 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
255
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
256 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
257 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
258
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
259 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
260 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
261 y[m.ridx(i)] += m.data(i) * x[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
262
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
263 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
264 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
265
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
266 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
267 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
268 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
269 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
270 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
271
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
272 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
273 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
274 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
275 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
276
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
277 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
278 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
279 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
280 ("eigs: unrecoverable error in dgemv");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
281 return false;
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 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
284 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
285 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
286
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
287 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
288 vector_product (const SparseComplexMatrix& m, const Complex* x,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
289 Complex* y)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
290 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
291 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
292
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
293 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
294 y[j] = 0.;
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 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
297 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
298 y[m.ridx(i)] += m.data(i) * x[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
299
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
300 return true;
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
303 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
304 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
305 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
306 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
307 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
308
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
309 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
310 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
311 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
312 F77_CHAR_ARG_LEN (1)));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
313
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
314 if (f77_exception_encountered)
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 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
317 ("eigs: unrecoverable error in zgemv");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
318 return false;
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 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
321 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
322 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
323
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
324 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
325 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
326 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
327 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
328 CHOL fact (b, info);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
329 octave_idx_type n = b.cols();
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 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
332 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
333 else
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 bt = fact.chol_matrix ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
336 b = bt.transpose();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
337 permB = ColumnVector(n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
338 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
339 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
340 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
341 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
342 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
343
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
344 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
345 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
346 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
347 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
348 SparseCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
349
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
350 if (fact.P() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
351 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
352 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
353 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
354 b = fact.L();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
355 bt = b.transpose();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
356 permB = fact.perm() - 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
357 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
358 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
359 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
360
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
361 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
362 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
363 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
364 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
365 ComplexCHOL fact (b, info);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
366 octave_idx_type n = b.cols();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
367
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
368 if (info != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
369 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
370 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
371 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
372 bt = fact.chol_matrix ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
373 b = bt.hermitian();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
374 permB = ColumnVector(n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
375 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
376 permB(i) = i;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
377 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
378 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
379 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
380
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
381 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
382 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
383 ColumnVector& permB)
8417
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 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
386 SparseComplexCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
387
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
388 if (fact.P() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
389 return false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
390 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
391 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
392 b = fact.L();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
393 bt = b.hermitian();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
394 permB = fact.perm() - 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
395 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
396 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
397 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
398
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
399 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
400 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
401 bool cholB, const ColumnVector& permB, double sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
402 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
403 octave_idx_type *Q)
8417
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 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
406 octave_idx_type n = m.rows();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
407
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
408 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
409 SparseMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
410
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
411 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
412 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
413 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
414 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
415 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
416 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
417 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
418 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
419 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
420 tmp.xcidx(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
421 tmp.xridx(i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
422 static_cast<octave_idx_type>(permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
423 tmp.xdata(i) = 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
424 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
425 tmp.xcidx(n) = n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
426
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
427 AminusSigmaB = AminusSigmaB - sigma * tmp *
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
428 b.transpose() * b * tmp.transpose();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
429 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
430 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
431 AminusSigmaB = AminusSigmaB - sigma *
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
432 b.transpose() * b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
433 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
434 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
435 AminusSigmaB = AminusSigmaB - sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
436 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
437 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
438 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
439 SparseMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
440
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
441 // Create sigma * speye(n,n)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
442 sigmat.xcidx (0) = 0;
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 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
445 sigmat.xdata(i) = sigma;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
446 sigmat.xridx(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
447 sigmat.xcidx(i+1) = i + 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
448 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
449
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
450 AminusSigmaB = AminusSigmaB - sigmat;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
451 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
452
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
453 SparseLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
454
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
455 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
456 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
457 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
458 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
459
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
460 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
461 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
462 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
463 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
464 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
465
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
466 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
467 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
468 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
469 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
470 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
471 double d = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
472 if (U.xcidx(j+1) > U.xcidx(j) &&
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
473 U.xridx (U.xcidx(j+1)-1) == j)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
474 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
475
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
476 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
477 minU = d;
8417
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 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
480 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
481 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
482
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
483 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
484 volatile double rcond_plus_one = rcond + 1.0;
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 if (rcond_plus_one == 1.0 || xisnan (rcond))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
487 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
488 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
489 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
490 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
491 (" an eigenvalue. Convergence is not guaranteed");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
492 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
493
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
494 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
495 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
496
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
497 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
498 LuAminusSigmaB (const Matrix &m, const Matrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
499 bool cholB, const ColumnVector& permB, double sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
500 Matrix &L, Matrix &U, octave_idx_type *P,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
501 octave_idx_type *Q)
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 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
504 octave_idx_type n = m.cols();
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 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
507 Matrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
508
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
509 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
510 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
511 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
512 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
513 Matrix tmp = sigma * b.transpose() * b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
514 const double *pB = permB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
515 double *p = AminusSigmaB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
516
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
517 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
518 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
519 for (octave_idx_type j = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
520 j < b.cols(); j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
521 for (octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
522 i < b.rows(); i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
523 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
524 static_cast<octave_idx_type>(pB[j]));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
525 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
526 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
527 AminusSigmaB = AminusSigmaB - tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
528 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
529 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
530 AminusSigmaB = AminusSigmaB - sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
531 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
532 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
533 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
534 double *p = AminusSigmaB.fortran_vec();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
535
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
536 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
537 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
538 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
539
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
540 LU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
541
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
542 L = fact.P().transpose() * fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
543 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
544 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
545 P[j] = Q[j] = j;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
546
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
547 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
548 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
549 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
550 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
551 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
552 double d = std::abs (U.xelem(j,j));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
553 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
554 minU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
555
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
556 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
557 maxU = d;
8417
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
560 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
561 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
562
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
563 if (rcond_plus_one == 1.0 || xisnan (rcond))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
564 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
565 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
566 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
567 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
568 (" an eigenvalue. Convergence is not guaranteed");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
569 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
570
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
571 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
572 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
573
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
574 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
575 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
576 bool cholB, const ColumnVector& permB, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
577 SparseComplexMatrix &L, SparseComplexMatrix &U,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
578 octave_idx_type *P, octave_idx_type *Q)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
579 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
580 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
581 octave_idx_type n = m.rows();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
582
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
583 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
584 SparseComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
585
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
586 if (have_b)
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 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
589 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
590 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
591 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
592 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
593 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
594 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
595 tmp.xcidx(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
596 tmp.xridx(i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
597 static_cast<octave_idx_type>(permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
598 tmp.xdata(i) = 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
599 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
600 tmp.xcidx(n) = n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
601
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
602 AminusSigmaB = AminusSigmaB - tmp * b.hermitian() * b *
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
603 tmp.transpose() * sigma;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
604 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
605 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
606 AminusSigmaB = AminusSigmaB - sigma * b.hermitian() * b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
607 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
608 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
609 AminusSigmaB = AminusSigmaB - sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
610 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
611 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
612 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
613 SparseComplexMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
614
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
615 // Create sigma * speye(n,n)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
616 sigmat.xcidx (0) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
617 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
618 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
619 sigmat.xdata(i) = sigma;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
620 sigmat.xridx(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
621 sigmat.xcidx(i+1) = i + 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
622 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
623
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
624 AminusSigmaB = AminusSigmaB - sigmat;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
625 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
626
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
627 SparseComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
628
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
629 L = fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
630 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
631 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
632 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
633
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
634 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
635 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
636 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
637 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
638 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
639
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
640 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
641 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
642 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
643 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
644 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
645 double d = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
646 if (U.xcidx(j+1) > U.xcidx(j) &&
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
647 U.xridx (U.xcidx(j+1)-1) == j)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
648 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
649
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
650 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
651 minU = d;
8417
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 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
654 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
655 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
656
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
657 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
658 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
659
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
660 if (rcond_plus_one == 1.0 || xisnan (rcond))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
661 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
662 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
663 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
664 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
665 (" an eigenvalue. Convergence is not guaranteed");
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
668 return true;
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 static bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
672 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
673 bool cholB, const ColumnVector& permB, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
674 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
675 octave_idx_type *Q)
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 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
678 octave_idx_type n = m.cols();
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 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
681 ComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
682
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
683 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
684 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
685 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
686 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
687 ComplexMatrix tmp = sigma * b.hermitian() * b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
688 const double *pB = permB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
689 Complex *p = AminusSigmaB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
690
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
691 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
692 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
693 for (octave_idx_type j = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
694 j < b.cols(); j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
695 for (octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
696 i < b.rows(); i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
697 *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
698 static_cast<octave_idx_type>(pB[j]));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
699 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
700 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
701 AminusSigmaB = AminusSigmaB - tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
702 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
703 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
704 AminusSigmaB = AminusSigmaB - sigma * b;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
705 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
706 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
707 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
708 Complex *p = AminusSigmaB.fortran_vec();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
709
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
710 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
711 p[i*(n+1)] -= sigma;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
712 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
713
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
714 ComplexLU fact (AminusSigmaB);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
715
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
716 L = fact.P().transpose() * fact.L ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
717 U = fact.U ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
718 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
719 P[j] = Q[j] = j;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
720
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
721 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
722 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
723 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
724 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
725 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
726 double d = std::abs (U.xelem(j,j));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
727 if (xisnan (minU) || d < minU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
728 minU = d;
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 if (xisnan (maxU) || d > maxU)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
731 maxU = d;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
732 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
733
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
734 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
735 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
736
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
737 if (rcond_plus_one == 1.0 || xisnan (rcond))
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 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
740 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
741 (*current_liboctave_warning_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
742 (" an eigenvalue. Convergence is not guaranteed");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
743 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
744
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
745 return true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
746 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
747
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
748 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
749 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
750 EigsRealSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
751 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
752 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
753 ColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
754 ColumnVector &permB, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
755 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
756 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
757 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
758 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
759 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
760 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
761 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
762 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
763 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
764 double sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
765 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
766
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
767 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
768 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
769 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
770 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
771 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
772 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
773 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
774 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
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 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
777 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
778
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
779 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
780 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
781 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
782 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
783 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
784 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
785 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
786
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
787 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
788 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
789 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
790 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
791 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
792 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
793
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
794 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
795 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
796 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
797
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
798 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
799 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
800
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
801 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
802 p = n - 1 ;
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
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
805 if (k < 1 || k > n - 2)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
806 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
807 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
808 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
809 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
810 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
811 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
812
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
813 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
814 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
815 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
816 ("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
817 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
818 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
819
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
820 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
821 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
822 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
823 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
824 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
825 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
826 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
827 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
828 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
829 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
830 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
831 Array<bool> checked(n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
832 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
833 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
834 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
835 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
836 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
837 bidx >= n || D_NINT (bidx) != bidx)
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 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
840 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
841 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
842 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
843 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
844 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
845 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
846
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
847 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
848 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
849 typ != "SI")
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
850 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
851 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
852 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
853 return -1;
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
856 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR")
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
857 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
858 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
859 ("eigs: invalid sigma value for real symmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
860 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
861 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
862
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
863 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
864 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
865 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
866 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
867 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
868 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
869 bt = b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
870 b = b.transpose();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
871 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
872 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
873 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
874 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
875 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
876 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
877 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
878 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
879 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
880 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
881 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
882 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
883 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
884 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
885 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
886 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
887 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
888
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
889 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
890 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
891
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
892 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
893 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
894 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
895 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
896 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
897 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
898 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
899 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
900 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
901 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
902 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
903 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
904
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
905 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
906 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
907
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
908 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
909 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
910 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
911
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
912 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
913 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
914 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
915 double *presid = resid.fortran_vec ();
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 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
918 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
919 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
920 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
921 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
922 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
923 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
924 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
925
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
926 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
927 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
928 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
929 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
930 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
931 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
932
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
933 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
934 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
935 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
936 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
937 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
938 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
939 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
940 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
941 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
942 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
943
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
944 // 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
945 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
946 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
947 // 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
948 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
949 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
950 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
951 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
952
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
953 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
954 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
955 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
956 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
957 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
958 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
959 mtmp(i,0) = workd[i + iptr(0) - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
960
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
961 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
962
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
963 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
964 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
965 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
966 else if (!vector_product (m, workd + iptr(0) - 1,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
967 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
968 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
969 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
970 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
971 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
972 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
973 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
974 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
975 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
976 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
977 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
978 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
979 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
980 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
981 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
982
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
983 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
984
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
985 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
986 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
987 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
988 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
989 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
990 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
991 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
992 Array<octave_idx_type> s (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
993 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
994
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
995 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
996 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
997
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
998 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
999 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1000
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1001 F77_FUNC (dseupd, DSEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1002 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1003 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1004 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1005 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1006 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1007
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1008 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1009 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1010 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1011 ("eigs: unrecoverable exception encountered in dseupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1012 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1013 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1014 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1015 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1016 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1017 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1018 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1019 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1020 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1021 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1022 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1023 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1024 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1025 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1026 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1027 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1028
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1029 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1030 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1031 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1032 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1033 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1034
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1035 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1036 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1037 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1038 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1039
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1040 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1041 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1042
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1043 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1044 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1045
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1046 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1047 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1048
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1049 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1050 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1051 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1052 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1053
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1054 if (note3)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1055 eig_vec = ltsolve(b, permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1056 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1057 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1058 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1059 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1060 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1061 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1062 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1063 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1064 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1065
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1066 return ip(4);
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1069 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1070 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1071 EigsRealSymmetricMatrixShift (const M& m, double sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1072 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1073 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1074 ColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1075 ColumnVector &permB, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
1076 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1077 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1078 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1079 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1080 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1081 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1082 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1083 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1084
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1085 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1086 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1087 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1088 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1089 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1090 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1091 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1092 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1093 ("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
1094 return -1;
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 // 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
1098 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1099 // 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
1100 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1101 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1102
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1103 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1104 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1105 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1106 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1107 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1108 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1109 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1110
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1111 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1112 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1113 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1114 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1115 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1116 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1117
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1118 if (k <= 0 || k >= n - 1)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1119 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1120 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1121 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1122 " Use 'eig(full(A))' instead");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1123 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1124 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1125
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1126 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1127 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1128 p = k * 2;
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 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1131 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1132
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1133 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1134 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1135 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1136
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1137 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1138 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1139 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1140 ("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
1141 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1142 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1143
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1144 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1145 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1146 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1147 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1148 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1149 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1150 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1151 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1152 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1153 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1154 Array<bool> checked (n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1155 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1156 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1157 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1158 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1159 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1160 bidx >= n || D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1161 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1162 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1163 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1164 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1165 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1166 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1167 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1168 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1169
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1170 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1171 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1172 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1173
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1174 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1175 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1176
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1177 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1178 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1179 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1180 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1181 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
1182 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1183 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1184 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1185 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1186 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1187 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1188 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1189
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1190 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1191 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1192
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1193 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1194 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1195 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1196
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1197 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1198 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1199
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1200 if (! LuAminusSigmaB(m, b, cholB, permB, sigma, L, U, P, Q))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1201 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1202
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1203 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1204
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1205 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1206 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1207 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1208 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1209
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1210 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1211 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1212 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1213 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1214 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1215 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1216 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1217 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
1218
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1219 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1220 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1221 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1222 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1223 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1224 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1225
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1226 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1227 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1228 if (iter++)
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 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1231 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1232 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1233 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1234 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1235 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1236
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1237 // 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
1238 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1239 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1240 // 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
1241 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1242 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1243 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1244 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1245
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1246 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1247 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1248 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1249 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1250 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1251 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1252 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1253
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1254 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1255
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1256 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1257
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1258 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1259 tmp(i,0) = dtmp[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1260
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1261 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1262
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1263 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1264 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1265 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1266 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1267 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1268 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
1269 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1270 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1271 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1272 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1273
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1274 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1275 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1276
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1277 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1278
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1279 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1280 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1281 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1282 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1283 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1284 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1285 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1286 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1287 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1288 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1289 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
1290 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1291 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1292 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1293 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1294 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1295
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1296 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1297 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1298
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1299 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1300
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1301 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1302 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1303 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1304 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1305 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1306 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1307 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1308 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1309 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1310 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1311 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1312 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1313 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1314 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1315 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1316 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1317 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1318 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1319
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1320 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1321
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1322 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1323 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1324 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1325 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1326 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1327 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1328 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1329 Array<octave_idx_type> s (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
1330 octave_idx_type *sel = s.fortran_vec ();
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1331
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1332 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1333 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1334
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1335 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1336 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1337
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1338 F77_FUNC (dseupd, DSEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1339 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1340 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1341 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1342 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
1343 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
1344
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1345 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1346 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1347 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1348 ("eigs: unrecoverable exception encountered in dseupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1349 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1350 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1351 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1352 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1353 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1354 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1355 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1356 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1357 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1358 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1359 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1360 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1361 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1362
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1363 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1364 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1365 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1366
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1367 for (octave_idx_type i = 0; i < k2; i++)
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 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1370 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1371
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1372 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1373 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1374
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1375 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1376 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1377
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1378 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1379 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1380
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1381 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1382 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1383 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1384 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1385 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1386 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1387 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1388 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1389 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1390 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1391 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1392 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1393
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1394 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1395 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1396
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1397 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1398 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1399 const std::string &_typ, double sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1400 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1401 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1402 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
1403 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1404 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1405 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1406 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1407 bool have_sigma = (sigma ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1408 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1409 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1410 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1411
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1412 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1413 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1414 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1415 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1416 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1417 octave_rand::distribution(rand_dist);
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
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1420 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1421 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1422 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1423 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1424 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1425 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1426
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1427 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1428 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1429 p = k * 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1430
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1431 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1432 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1433
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1434 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1435 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1436 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1437
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1438 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1439 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1440 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1441 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1442 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1443 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1444 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1445
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1446 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1447 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1448 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1449 ("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
1450 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1451 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1452
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1453 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1454 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1455 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1456 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1457 typ != "SI")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1458 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1459 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1460
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1461 if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1462 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1463 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1464 ("eigs: invalid sigma value for real symmetric problem");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1465 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1466 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1467
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1468 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1469 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1470 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1471 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1472 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1473 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1474 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1475 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1476 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1477 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1478 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1479 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1480 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1481 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1482
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1483 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1484 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1485
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1486 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1487 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1488 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1489 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1490 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
1491 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1492 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1493 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1494 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1495 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1496 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1497 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1498
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1499 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1500 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1501
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1502 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1503 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1504 octave_idx_type lwork = p * (p + 8);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1505
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1506 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1507 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1508 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1509 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1510
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1511 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1512 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1513 F77_FUNC (dsaupd, DSAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1514 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1515 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1516 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1517 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1518 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
1519
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1520 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1521 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1522 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1523 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1524 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1525 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1526
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1527 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1528 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1529 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1530 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1531 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1532 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1533 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1534 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1535 os << " " << workl[iptr(5)+i-1] << "\n";
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 // 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
1539 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1540 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1541 // 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
1542 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1543 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1544 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1545 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1546
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1547
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1548 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1549 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1550 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1551 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1552
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1553 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1554 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1555
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1556 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1557
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1558 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1559 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1560
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1561 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1562 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1563 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1564 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1565 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1566 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1567 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1568 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1569 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1570 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1571 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1572 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1573 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1574 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1575 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1576 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1577
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1578 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1579
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1580 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1581 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1582 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1583 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1584 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1585 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1586 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1587 Array<octave_idx_type> s (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
1588 octave_idx_type *sel = s.fortran_vec ();
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1589
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1590 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1591 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1592
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1593 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1594 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1595
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1596 F77_FUNC (dseupd, DSEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1597 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1598 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1599 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1600 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
1601 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
1602
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1603 if (f77_exception_encountered)
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 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1606 ("eigs: unrecoverable exception encountered in dseupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1607 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1608 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1609 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1610 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1611 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1612 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1613 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1614 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1615 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1616 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1617 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1618 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1619 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1620 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1621 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1622 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1623
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1624 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1625 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1626 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1627 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1628 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1629
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1630 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1631 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1632 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1633 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1634
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1635 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1636 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1637
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1638 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1639 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1640
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1641 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1642 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1643
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1644 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1645 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1646 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1647 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1648 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1649 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1650 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1651 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1652 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1653 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1654 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1655 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1656 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1657
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1658 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1659 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1660
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1661 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1662 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1663 EigsRealNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1664 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1665 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1666 ComplexColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1667 ColumnVector &permB, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
1668 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1669 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1670 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1671 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1672 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1673 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1674 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1675 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1676 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1677 double sigmar = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1678 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1679 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1680
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1681 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1682 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1683 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1684 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1685 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1686 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1687 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1688 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1689 ("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
1690 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1691 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1692
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1693 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1694 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1695 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1696 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1697 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1698 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1699 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1700
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1701 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1702 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1703 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1704 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1705 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1706 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1707
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1708 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1709 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1710 p = k * 2 + 1;
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 (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1713 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1714
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1715 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1716 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1717 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1718
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1719 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1720 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1721 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1722 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1723 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1724 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1725 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1726
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
1727 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1728 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1729 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1730 ("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
1731 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1732 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1733
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1734 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1735 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1736 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1737 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1738 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1739 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1740 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1741 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1742 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1743 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1744 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1745 Array<bool> checked (n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1746 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1747 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1748 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1749 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1750 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1751 bidx >= n || D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1752 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1753 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1754 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1755 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1756 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1757 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1758 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1759 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1760
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1761 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1762 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1763 typ != "SI")
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1764 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1765 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1766 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1767 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1768 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1769
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1770 if (typ == "LA" || typ == "SA" || typ == "BE")
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1771 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1772 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1773 ("eigs: invalid sigma value for unsymmetric problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1774 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1775 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1776
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1777 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1778 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1779 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1780 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1781 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1782 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1783 bt = b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1784 b = b.transpose();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1785 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1786 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1787 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1788 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1789 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1790 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1791 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1792 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1793 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1794 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1795 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1796 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1797 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1798 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1799 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1800 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1801 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1802
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1803 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1804 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1805
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1806 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1807 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1808 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1809 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1810 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
1811 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1812 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1813 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1814 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1815 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1816 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1817 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1818
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1819 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1820 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1821
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1822 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1823 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1824 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1825
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1826 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1827 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1828 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1829 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1830
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1831 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1832 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1833 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1834 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1835 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1836 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1837 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1838 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
1839
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1840 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1841 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1842 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1843 ("eigs: unrecoverable exception encountered in dnaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1844 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1845 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1846
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1847 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1848 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1849 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1850 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1851 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1852 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1853 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1854 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1855 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1856 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1857
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1858 // 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
1859 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1860 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1861 // 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
1862 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1863 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1864 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1865 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1866
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1867 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1868 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1869 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1870 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1871 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1872 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1873 mtmp(i,0) = workd[i + iptr(0) - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1874
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1875 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1876
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1877 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1878 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1879 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1880 else if (!vector_product (m, workd + iptr(0) - 1,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1881 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1882 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1883 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1884 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1885 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1886 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1887 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1888 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1889 ("eigs: error %d in dnaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1890 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1891 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1892 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1893 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1894 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1895 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1896
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1897 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1898
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1899 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1900 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
1901 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1902 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1903 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1904 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1905 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1906 Array<octave_idx_type> s (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
1907 octave_idx_type *sel = s.fortran_vec ();
8417
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 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1910 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1911
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1912 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1913 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1914 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1915 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
1916 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1917
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1918 F77_FUNC (dneupd, DNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1919 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1920 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1921 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1922 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1923 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1924
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1925 if (f77_exception_encountered)
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 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1928 ("eigs: unrecoverable exception encountered in dneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1929 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1930 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1931 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1932 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1933 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1934 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1935
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
1936 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1937 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1938 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1939 for (octave_idx_type i = 0; i < k+1; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1940 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1941 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1942 jj++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1943 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1944 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1945 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1946 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1947 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1948 d[i] = d[i+1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1949
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1950 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1951 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1952 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1953 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1954 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1955 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1956 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1957 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1958
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1959 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1960 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1961 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1962
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1963 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1964 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1965 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1966 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1967
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1968 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1969 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1970
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1971 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1972 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1973
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1974 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1975 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1976
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1977 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1978 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1979 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1980
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1981 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1982 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1983 while (i < k)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1984 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1985 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1986 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1987 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1988 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1989 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1990 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1991 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1992 i++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1993 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1994 else
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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1997 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1998 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
1999 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2000 if (i < k - 1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2001 eig_vec(j,i+1) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2002 Complex(z[j+off1],-z[j+off2]);
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 i+=2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2005 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2006 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2007
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2008 if (note3)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2009 eig_vec = ltsolve(M (b), permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2010 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2011 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2012 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2013 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2014 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2015 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2016 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2017 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2018 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2019
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2020 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2021 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2022
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2023 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2024 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2025 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2026 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2027 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2028 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2029 ComplexColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2030 ColumnVector &permB, ColumnVector &resid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
2031 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2032 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2033 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2034 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2035 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2036 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2037 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2038 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2039 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2040
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2041 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2042 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2043 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2044 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2045 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2046 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2047 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2048 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2049 ("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
2050 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2051 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2052
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2053 // 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
2054 //if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2055 // 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
2056 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2057 // disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2058
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2059 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2060 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2061 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2062 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2063 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2064 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2065 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2066
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2067 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2068 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2069 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2070 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2071 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2072 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2073
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2074 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2075 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2076 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2077
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2078 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2079 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2080
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2081 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2082 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2083 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2084
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2085 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2086 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2087 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2088 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2089 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2090 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2091 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2092
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2093 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2094 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2095 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2096 ("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
2097 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2098 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2099
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2100 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2101 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2102 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2103 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2104 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2105 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2106 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2107 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2108 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2109 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2110 Array<bool> checked (n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2111 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2112 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2113 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2114 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2115 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2116 bidx >= n || D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2117 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2118 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2119 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2120 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2121 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2122 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2123 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2124 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2125
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2126 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2127 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2128 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2129
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2130 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2131 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2132
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2133 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2134 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2135 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2136 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2137 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
2138 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2139 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2140 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2141 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2142 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2143 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2144 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2145
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2146 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2147 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2148
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2149 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2150 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2151 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2152
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2153 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2154 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2155
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2156 if (! LuAminusSigmaB(m, b, cholB, permB, sigmar, L, U, P, Q))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2157 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2158
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2159 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2160
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2161 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2162 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2163 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2164 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2165
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2166 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2167 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2168 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2169 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2170 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2171 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2172 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2173 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
2174
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2175 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2176 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2177 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2178 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2179 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2180 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2181
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2182 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2183 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2184 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2185 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2186 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2187 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2188 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2189 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2190 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2191 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2192
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2193 // 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
2194 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2195 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2196 // 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
2197 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2198 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2199 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2200 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2201
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2202 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2203 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2204 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2205 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2206 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2207 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2208 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2209
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2210 vector_product (m, workd+iptr(0)-1, dtmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2211
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2212 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2213
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2214 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2215 tmp(i,0) = dtmp[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2216
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2217 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2218
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2219 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2220 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2221 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2222 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2223 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2224 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
2225 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2226 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2227 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2228 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2229
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2230 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2231 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2232
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2233 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2234
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2235 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2236 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2237 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2238 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2239 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2240 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2241 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2242 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2243 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2244 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2245 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
2246 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2247 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2248 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2249 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2250 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2251
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2252 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2253 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2254
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2255 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2256
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2257 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2258 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2259 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2260 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2261 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2262 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2263 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2264 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2265 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2266 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2267 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2268 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2269 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2270 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2271 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2272 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2273 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2274 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2275
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2276 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2277
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2278 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2279 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2280 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2281 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2282 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2283 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2284 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2285 Array<octave_idx_type> s (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
2286 octave_idx_type *sel = s.fortran_vec ();
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2287
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2288 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2289 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2290
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2291 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2292 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2293 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2294 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
2295 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2296
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2297 F77_FUNC (dneupd, DNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2298 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2299 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2300 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2301 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2302 F77_CHAR_ARG_LEN(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 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2305 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2306 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2307 ("eigs: unrecoverable exception encountered in dneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2308 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2309 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2310 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2311 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2312 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2313 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2314
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2315 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2316 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2317 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2318 for (octave_idx_type i = 0; i < k+1; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2319 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2320 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2321 jj++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2322 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2323 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2324 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2325 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2326 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2327 d[i] = d[i+1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2328
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2329 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2330 for (octave_idx_type i = 0; i < k2; i++)
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 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2333 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2334 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2335 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2336 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2337
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2338 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2339 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2340 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2341
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2342 for (octave_idx_type i = 0; i < k2; i++)
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 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2345 octave_idx_type off2 = (k - i - 1) * 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 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2348 continue;
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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2351 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2352
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2353 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2354 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2355
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2356 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2357 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2358 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2359
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2360 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2361 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2362 while (i < k)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2363 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2364 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2365 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2366 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2367 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2368 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2369 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2370 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2371 i++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2372 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2373 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2374 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2375 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2376 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2377 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2378 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2379 if (i < k - 1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2380 eig_vec(j,i+1) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2381 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2382 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2383 i+=2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2384 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2385 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2386 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2387 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2388 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2389 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2390 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2391 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2392 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2393 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2394 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2395
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2396 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2397 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2398
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2399 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2400 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2401 const std::string &_typ, double sigmar,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2402 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2403 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2404 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
2405 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2406 bool /* cholB */, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2407 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2408 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2409 bool have_sigma = (sigmar ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2410 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2411 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2412 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2413 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2414
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2415 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2416 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2417 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2418 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2419 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2420 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2421 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2422
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2423 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2424 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2425 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2426 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2427 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2428 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2429
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2430 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2431 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2432 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2433
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2434 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2435 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2436
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2437 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2438 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2439 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2440
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2441 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2442 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2443 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2444 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2445 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2446 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2447 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2448
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2449 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2450 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2451 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2452 ("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
2453 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2454 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2455
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2456
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2457 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2458 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2459 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2460 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2461 typ != "SI")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2462 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2463 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2464
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2465 if (typ == "LA" || typ == "SA" || typ == "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2466 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2467 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2468 ("eigs: invalid sigma value for unsymmetric problem");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2469 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2470 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2471
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2472 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2473 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2474 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2475 sigmar = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2476 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2477 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2478 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2479 else if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2480 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2481 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2482 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2483 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2484 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2485 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2486
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2487 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2488 octave_idx_type *iparam = ip.fortran_vec ();
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 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2491 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2492 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2493 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2494 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
2495 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2496 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2497 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2498 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2499 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2500 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2501 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2502
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2503 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2504 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2505
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2506 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2507 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2508 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2509
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2510 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2511 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2512 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2513 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2514
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2515 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2516 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2517 F77_FUNC (dnaupd, DNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2518 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2519 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2520 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2521 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2522 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
2523
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2524 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2525 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2526 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2527 ("eigs: unrecoverable exception encountered in dnaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2528 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2529 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2530
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2531 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2532 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2533 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2534 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2535 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2536 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2537 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2538 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2539 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2540 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2541
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2542 // 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
2543 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2544 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2545 // 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
2546 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2547 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2548 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2549 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2550
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2551 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2552 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2553 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2554 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2555
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2556 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2557 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2558
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2559 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2560
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2561 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2562 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2563
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2564 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2565 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2566 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2567 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2568 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2569 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2570 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2571 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2572 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2573 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2574 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2575 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2576 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2577 }
8417
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 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2580
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2581 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2582
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2583 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2584 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2585 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2586 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2587 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2588 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2589 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2590 Array<octave_idx_type> s (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
2591 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2592
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2593 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2594 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2595
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2596 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2597 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2598 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2599 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
2600 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2601
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2602 F77_FUNC (dneupd, DNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2603 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2604 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2605 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2606 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2607 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2608
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2609 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2610 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2611 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2612 ("eigs: unrecoverable exception encountered in dneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2613 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2614 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2615 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2616 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2617 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2618 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2619
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2620 if (info2 == 0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2621 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2622 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2623 for (octave_idx_type i = 0; i < k+1; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2624 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2625 if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2626 jj++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2627 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2628 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2629 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2630 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2631 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2632 d[i] = d[i+1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2633
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2634 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2635 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2636 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2637 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2638 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2639 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2640 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2641 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2642
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2643 if (rvec)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2644 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2645 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2646
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2647 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2648 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2649 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2650 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2651
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2652 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2653 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2654
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2655 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2656 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2657
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2658 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2659 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2660
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2661 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2662 z[off2 + j] = dtmp[j];
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
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2665 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2666 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2667 while (i < k)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2668 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2669 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2670 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2671 if (std::imag(eig_val(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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2674 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2675 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2676 i++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2677 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2678 else
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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2681 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2682 eig_vec(j,i) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2683 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2684 if (i < k - 1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2685 eig_vec(j,i+1) =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2686 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2687 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2688 i+=2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2689 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2690 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2691 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2692 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2693 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2694 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2695 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2696 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2697 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2698 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2699 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2700
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2701 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2702 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2703
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2704 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2705 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2706 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2707 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2708 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2709 ComplexColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2710 ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2711 ComplexColumnVector &cresid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
2712 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2713 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2714 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2715 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2716 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2717 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2718 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2719 bool note3 = false;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2720 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2721 Complex sigma = 0.;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2722 M bt;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2723
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2724 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2725 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2726 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2727 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2728 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2729 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2730 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2731 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2732 ("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
2733 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2734 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2735
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2736 if (cresid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2737 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2738 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2739 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2740 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2741 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2742 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2743 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
2744 cresid(i) = Complex(rr(i),ri(i));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2745 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2746 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2747
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2748 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2749 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2750 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2751 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2752 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2753 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2754
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2755 if (p < 0)
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 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2758
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2759 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2760 p = 20;
8417
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 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2763 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2764 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2765
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2766 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2767 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2768 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2769 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2770 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2771 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2772 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2773
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
2774 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2775 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2776 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2777 ("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
2778 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2779 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2780
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2781 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2782 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2783 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2784 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2785 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2786 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2787 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2788 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2789 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2790 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2791 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2792 Array<bool> checked (n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2793 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2794 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2795 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2796 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2797 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2798 bidx >= n || D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2799 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2800 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2801 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2802 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2803 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2804 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2805 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2806 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2807
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2808 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2809 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2810 typ != "SI")
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 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2813 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2814 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2815 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2816
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2817 if (typ == "LA" || typ == "SA" || typ == "BE")
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2818 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2819 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2820 ("eigs: invalid sigma value for complex problem");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2821 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2822 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2823
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2824 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2825 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2826 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2827 note3 = true;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2828 if (cholB)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2829 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2830 bt = b;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2831 b = b.hermitian();
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2832 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2833 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2834 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2835 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2836 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2837 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2838 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2839 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2840 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2841 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2842 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2843 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2844 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2845 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2846 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2847 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2848 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2849
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2850 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2851 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2852
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2853 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2854 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2855 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2856 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2857 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
2858 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2859 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2860 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2861 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2862 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2863 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2864 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2865
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2866 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2867 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2868
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2869 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2870 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2871 octave_idx_type lwork = p * (3 * p + 5);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2872
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2873 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2874 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2875 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2876 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2877 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2878
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2879 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2880 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2881 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2882 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2883 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2884 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2885 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2886 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
2887
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2888 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2889 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2890 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2891 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2892 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2893 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2894
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2895 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2896 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2897 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2898 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2899 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2900 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2901 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2902 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2903 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2904 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2905
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2906 // 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
2907 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2908 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2909 // 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
2910 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2911 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2912 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2913 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2914
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2915 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2916 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2917 if (have_b)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2918 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2919 ComplexMatrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2920 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2921 mtmp(i,0) = workd[i + iptr(0) - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2922 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2923 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2924 workd[i+iptr(1)-1] = mtmp(i,0);
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 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2927 else if (!vector_product (m, workd + iptr(0) - 1,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2928 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2929 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2930 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2931 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2932 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2933 if (info < 0)
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 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2936 ("eigs: error %d in znaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2937 return -1;
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 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2940 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2941 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2942 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2943
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2944 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2945
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2946 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2947 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2948 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2949 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2950 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2951 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2952 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
2953 Array<octave_idx_type> s (p, 1);
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
2954 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2955
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2956 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2957 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2958
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2959 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2960 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2961
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2962 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2963
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2964 F77_FUNC (zneupd, ZNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2965 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma, workev,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2966 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2967 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2968 k, tol, presid, p, v, n, iparam, ipntr, workd, workl, lwork, rwork, info2
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2969 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2970
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2971 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2972 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2973 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2974 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2975 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2976 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2977
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2978 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2979 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2980 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2981 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
2982 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2983 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2984 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2985 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2986 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2987 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2988
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
2989 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2990 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2991 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2992
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2993 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2994 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2995 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2996 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2997
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2998 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2999 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3000
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3001 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3002 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3003
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3004 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3005 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3006
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3007 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3008 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3009 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3010
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3011 if (note3)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3012 eig_vec = ltsolve(b, permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3013 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3014 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3015 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3016 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3017 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3018 ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3019 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3020 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3021
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3022 return ip(4);
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3025 template <class M>
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3026 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3027 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3028 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3029 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3030 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3031 ComplexColumnVector &eig_val, const M& _b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3032 ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3033 ComplexColumnVector &cresid,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3034 std::ostream& os, double tol, bool rvec,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3035 bool cholB, int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3036 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3037 M b(_b);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3038 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3039 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3040 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3041 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3042
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3043 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3044 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3045 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3046 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3047 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3048 if (have_b && (m.rows() != b.rows() || m.rows() != b.cols()))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3049 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3050 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3051 ("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
3052 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3053 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3054
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3055 // 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
3056 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3057 // 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
3058 // eig_val, _b, permB, cresid, os, tol,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3059 // rvec, cholB, disp, maxit);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3060
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3061 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3064 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3065 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3066 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3067 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3068 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
3069 cresid(i) = Complex(rr(i),ri(i));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3070 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3071 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3072
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3073 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3074 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3075 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3076 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3077 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3078 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3079
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3080 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3081 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3082 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3083
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3084 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3085 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3086
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3087 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3088 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3089 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3090
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3091 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3092 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3093 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3094 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3095 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3096 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3097 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3098
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3099 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3100 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3101 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3102 ("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
3103 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3104 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3105
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3106 if (have_b && cholB && permB.length() != 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3107 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3108 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3109 if (permB.length() != n)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3110 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3111 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3112 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3113 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3114 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3115 {
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3116 Array<bool> checked (n, 1, false);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3117 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3118 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3119 octave_idx_type bidx =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3120 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3121 if (checked(bidx) || bidx < 0 ||
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3122 bidx >= n || D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3123 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3124 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3125 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3126 return -1;
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 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3129 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3130 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3131
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3132 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3133 if (have_b)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3134 bmat = 'G';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3135
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3136 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3137 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3138
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3139 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3140 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3141 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3142 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3143 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
3144 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3145 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3146 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3147 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3148 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3149 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3150 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3151
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3152 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3153 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3154
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3155 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3156 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3157 M L, U;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3158
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3159 OCTAVE_LOCAL_BUFFER (octave_idx_type, P, (have_b ? b.rows() : m.rows()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3160 OCTAVE_LOCAL_BUFFER (octave_idx_type, Q, (have_b ? b.cols() : m.cols()));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3161
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3162 if (! LuAminusSigmaB(m, b, cholB, permB, sigma, L, U, P, Q))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3163 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3164
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3165 octave_idx_type lwork = p * (3 * p + 5);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3166
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3167 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3168 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3169 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3170 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3171 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3172
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3173 do
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3174 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3175 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3176 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3177 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3178 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3179 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3180 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
3181
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3182 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3183 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3184 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3185 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3186 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3187 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3188
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3189 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3190 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3191 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3192 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3193 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3194 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3195 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3196 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3197 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3198 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3199
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3200 // 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
3201 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3202 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3203 // 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
3204 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3205 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3206 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3207 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3208
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3209 if (ido == -1 || ido == 1 || ido == 2)
10314
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 if (have_b)
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 (ido == -1)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3214 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3215 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3216
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3217 vector_product (m, workd+iptr(0)-1, ctmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3218
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3219 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3220
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3221 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3222 tmp(i,0) = ctmp[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3223
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3224 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3225
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3226 Complex *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3227 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3228 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3229 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3230 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3231 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
3232 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3233 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3234 Complex *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3235 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3236
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3237 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3238 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3239
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3240 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3241
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3242 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3243 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3244 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3245 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3246 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3247 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3248 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3249 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3250 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3251 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3252 workd[iptr(0) + i - 1] =
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3253 workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3254 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3255 else
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3256 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3257 Complex *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3258 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3259
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3260 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3261 tmp(i,0) = ip2[P[i]];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3262
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3263 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3264
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3265 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3266 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3267 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3268 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3269 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3270 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3271 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3272 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3273 if (info < 0)
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 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3276 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3277 return -1;
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 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3280 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3281 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3282 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3283
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3284 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3285
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3286 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3287 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3288 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3289 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3290 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3291 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3292 // avoid problems.
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3293 Array<octave_idx_type> s (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
3294 octave_idx_type *sel = s.fortran_vec ();
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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3297 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3300 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3301
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3302 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3303
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3304 F77_FUNC (zneupd, ZNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3305 (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
3306 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3307 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3308 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
3309 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
3310
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3311 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3312 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3313 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3314 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3315 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3316 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3317
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3318 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3319 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3320 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3321 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
3322 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3323 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3324 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3325 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3326 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3327 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3328
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3329 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3330 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3331 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3332
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3333 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3334 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3335 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3336 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3337
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3338 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3339 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3340
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3341 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3342 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3343
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3344 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3345 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3346
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3347 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3348 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3349 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3350 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3351 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3352 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3353 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3354 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3355 ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3356 return -1;
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
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3359 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3360 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3361
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3362 octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3363 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3364 const std::string &_typ, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3365 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3366 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3367 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3368 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
3369 double tol, bool rvec, bool /* cholB */,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3370 int disp, int maxit)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3371 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3372 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3373 bool have_sigma = (std::abs(sigma) ? true : false);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3374 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3375 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3376 int err = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3377
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3378 if (cresid.is_empty())
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3379 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3380 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3381 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3382 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3383 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3384 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3385 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
3386 cresid(i) = Complex(rr(i),ri(i));
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3387 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3388 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3389
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3390 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3391 {
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3392 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3393 ("eigs: n must be at least 3");
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3394 return -1;
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3395 }
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3396
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3397 if (p < 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3398 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3399 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3400
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3401 if (p < 20)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3402 p = 20;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3403
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3404 if (p > n - 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3405 p = n - 1 ;
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3406 }
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3407
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3408 if (k <= 0 || k >= n - 1)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3409 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3410 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3411 ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n"
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3412 " Use 'eig(full(A))' instead");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3413 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3414 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3415
9228
ab40ef1e232f fix tests within eigs-base.cc
Jaroslav Hajek <highegg@gmail.com>
parents: 8920
diff changeset
3416 if (p <= k || p >= n)
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3417 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3418 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3419 ("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
3420 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3421 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3422
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3423 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3424 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3425 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3426 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3427 typ != "SI")
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3428 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3429 ("eigs: unrecognized sigma value");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3430
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3431 if (typ == "LA" || typ == "SA" || typ == "BE")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3432 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3433 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3434 ("eigs: invalid sigma value for complex problem");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3435 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3436 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3437
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3438 if (typ == "SM")
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3439 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3440 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3441 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3442 mode = 3;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3443 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3444 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3445 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3446 typ = "SM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3447 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3448 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3449 typ = "LM";
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3450 mode = 3;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3451 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3452
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3453 Array<octave_idx_type> ip (11, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3454 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3455
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3456 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3457 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3458 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3459 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3460 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
3461 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3462 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3463 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3464 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3465 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3466 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3467 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3468
10350
12884915a8e4 merge MArray classes & improve Array interface
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
3469 Array<octave_idx_type> iptr (14, 1);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3470 octave_idx_type *ipntr = iptr.fortran_vec ();
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 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3473 int iter = 0;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3474 octave_idx_type lwork = p * (3 * p + 5);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3475
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3476 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3477 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3478 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3479 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3480 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3481
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3482 do
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 F77_FUNC (znaupd, ZNAUPD)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3485 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3486 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3487 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3488 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3489 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
3490
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3491 if (f77_exception_encountered)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3492 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3493 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3494 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3495 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3496 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3497
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3498 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3499 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3500 if (iter++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3501 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3502 os << "Iteration " << iter - 1 <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3503 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3504 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3505 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3506 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3507 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3508
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3509 // 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
3510 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3511 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3512 // 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
3513 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3514 if (ido != 99)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3515 workl[iptr(5)-1] = octave_NaN;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3516 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3517
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3518 if (ido == -1 || ido == 1 || ido == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3519 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3520 Complex *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3521 ComplexColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3522
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3523 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3524 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3525
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3526 ComplexColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3527
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3528 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3529 return false;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3530
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3531 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3532 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3533 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3534 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3535 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3536 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3537 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3538 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3539 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3540 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3541 return -1;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3542 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3543 break;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3544 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3545 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3546 while (1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3547
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3548 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3549
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3550 // We have a problem in that the size of the C++ bool
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3551 // type relative to the fortran logical type. It appears
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3552 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3553 // per bool, though this might be system dependent. As
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3554 // long as the HOWMNY arg is not "S", the logical array
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3555 // is just workspace for ARPACK, so use int type to
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3556 // avoid problems.
9391
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3557 Array<octave_idx_type> s (p);
333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values
Alexander Barth <barth.alexander@gmail.com>
parents: 9228
diff changeset
3558 octave_idx_type *sel = s.fortran_vec ();
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3559
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3560 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3561 Complex *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3562
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3563 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3564 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3565
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3566 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3567
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3568 F77_FUNC (zneupd, ZNEUPD)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3569 (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
3570 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3571 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3572 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
3573 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
3574
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3575 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3576 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3577 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3578 ("eigs: unrecoverable exception encountered in zneupd");
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3579 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3580 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3581
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3582 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3583 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3584 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3585 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
3586 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3587 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3588 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3589 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3590 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3591 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3592
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3593 if (rvec)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3594 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3595 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3596
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3597 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3598 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3599 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3600 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3601
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3602 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3603 continue;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3604
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3605 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3606 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3607
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3608 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3609 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3610
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3611 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3612 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3613 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3614 }
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3615 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3616 else
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3617 {
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3618 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3619 ("eigs: error %d in zneupd", info2);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3620 return -1;
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3621 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3622
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3623 return ip(4);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3624 }
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3625
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3626 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3627 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3628 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3629 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3630 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3631 ColumnVector &eig_val, const Matrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3632 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3633 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3634 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
3635 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3636
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3637 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3638 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3639 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3640 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3641 ColumnVector &eig_val, const SparseMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3642 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3643 std::ostream& os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3644 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
3645 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3646
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3647 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3648 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3649 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3650 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3651 ColumnVector &eig_val, const Matrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3652 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3653 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3654 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
3655 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3656
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3657 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3658 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3659 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3660 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3661 ColumnVector &eig_val, const SparseMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3662 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3663 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3664 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
3665 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3666
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3667 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3668 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3669 const std::string &typ, double sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3670 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3671 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3672 Matrix &eig_vec, ColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3673 ColumnVector &resid, std::ostream &os,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3674 double tol = DBL_EPSILON, bool rvec = false,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3675 bool cholB = 0, int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3676
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3677 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3678 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3679 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3680 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3681 ComplexColumnVector &eig_val, const Matrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3682 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3683 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3684 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
3685 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3686
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3687 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3688 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3689 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3690 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3691 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3692 const SparseMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3693 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3694 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3695 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
3696 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3697
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3698 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3699 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3700 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3701 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3702 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3703 ComplexColumnVector &eig_val, const Matrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3704 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3705 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3706 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
3707 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3708
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3709 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3710 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3711 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3712 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3713 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3714 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3715 const SparseMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3716 ColumnVector &permB, ColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3717 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3718 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
3719 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3720
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3721 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3722 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3723 const std::string &_typ, double sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3724 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3725 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3726 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3727 ColumnVector &resid, std::ostream& os,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3728 double tol = DBL_EPSILON, bool rvec = false,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3729 bool cholB = 0, int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3730
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3731 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3732 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3733 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3734 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3735 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3736 const ComplexMatrix& b, ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3737 ComplexColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3738 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3739 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
3740 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3741
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3742 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3743 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3744 const std::string typ, octave_idx_type k,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3745 octave_idx_type p, octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3746 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3747 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3748 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3749 ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3750 ComplexColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3751 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3752 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
3753 int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3754
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3755 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3756 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3757 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3758 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3759 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3760 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3761 const ComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3762 ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3763 ComplexColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3764 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3765 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3766 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3767
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3768 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3769 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3770 Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3771 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3772 octave_idx_type &info,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3773 ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3774 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3775 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3776 ColumnVector &permB,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3777 ComplexColumnVector &resid,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3778 std::ostream &os, double tol = DBL_EPSILON,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3779 bool rvec = false, bool cholB = 0,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3780 int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3781
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3782 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3783 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3784 const std::string &_typ, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3785 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3786 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3787 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3788 ComplexColumnVector &resid, std::ostream& os,
10361
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions
John W. Eaton <jwe@octave.org>
parents: 10350
diff changeset
3789 double tol = DBL_EPSILON, bool rvec = false,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3790 bool cholB = 0, int disp = 0, int maxit = 300);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3791 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3792
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3793 #ifndef _MSC_VER
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3794 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3795 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3796
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3797 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3798 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3799 ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3800
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3801 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3802 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3803
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3804 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3805 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3806
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3807 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3808 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3809 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3810
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3811 template static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3812 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3813
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3814 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3815 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3816
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3817 template static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3818 ltsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3819
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3820 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3821 utsolve (const SparseComplexMatrix&, const ColumnVector&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
3822 const ComplexMatrix&);
8417
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3823
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3824 template static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3825 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3826
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3827 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3828 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3829
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3830 template static Matrix
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3831 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3832 #endif
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3833
654bcfb937bf Add the eigs and svds functions
David Bateman <dbateman@free.fr>
parents:
diff changeset
3834 #endif