octave-nkf: liboctave/eigs-base.cc annotate

annotate liboctave/eigs-base.cc @ 11586:12df7854fa7c

strip trailing whitespace from source files

author	John W. Eaton <jwe@octave.org>
date	Thu, 20 Jan 2011 17:24:59 -0500
parents	57632dea2446
children	d25dfa9ed18b

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
11523 fd0a3ac60b0e update copyright notices John W. Eaton <jwe@octave.org> parents: 11518 diff changeset	3 Copyright (C) 2005-2011 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);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	49 typedef ComplexColumnVector (*EigsComplexFunc)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	50 (const ComplexColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	51
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	52 // Arpack and blas fortran functions we call.
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	53 extern "C"
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	54 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	55 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	56 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	57 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	58 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	59 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	60 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	61 double, const octave_idx_type&, double,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	62 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	63 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	64 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	65 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	66 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	67
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	68 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	69 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	70 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	71 octave_idx_type, double, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	72 const octave_idx_type&, const double&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	73 F77_CONST_CHAR_ARG_DECL,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	74 const octave_idx_type&,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	75 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	76 const octave_idx_type&, const double&, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	77 const octave_idx_type&, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	78 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	79 octave_idx_type, double, double*,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	80 const octave_idx_type&, octave_idx_type&
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	81 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	82 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	83 F77_CHAR_ARG_LEN_DECL);
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	84
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	85 F77_RET_T
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	86 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	87 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	88 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	89 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	90 octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	91 double, const octave_idx_type&, double,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	92 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	93 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	94 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	95 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	96 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	97
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	98 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	99 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	100 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	101 octave_idx_type, double, double*,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	102 double*, const octave_idx_type&, const double&,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	103 const double&, double*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	104 F77_CONST_CHAR_ARG_DECL,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	105 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	106 F77_CONST_CHAR_ARG_DECL,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	107 octave_idx_type&, const double&, double*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	108 const octave_idx_type&, double*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	109 const octave_idx_type&, octave_idx_type*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	110 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	111 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	112 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	113 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	114 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	115
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	116 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	117 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	118 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	119 const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	120 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	121 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	122 Complex, const octave_idx_type&, Complex,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	123 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	124 octave_idx_type, Complex, Complex*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	125 const octave_idx_type&, double *, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	126 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	127 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	128
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	129 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	130 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	131 F77_CONST_CHAR_ARG_DECL,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	132 octave_idx_type, Complex, Complex*,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	133 const octave_idx_type&, const Complex&, Complex*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	134 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	135 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	136 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	137 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	138 Complex, const octave_idx_type&, Complex,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	139 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	140 octave_idx_type, Complex, Complex*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	141 const octave_idx_type&, double *, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	142 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	143 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	144 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	145
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	146 F77_RET_T
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	147 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	148 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	149 const double&, const double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	150 const octave_idx_type&, const double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	151 const octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	152 const octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	153 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	154
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	155
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	156 F77_RET_T
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	157 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	158 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	159 const Complex, const octave_idx_type&, const Complex,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	160 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	161 F77_CHAR_ARG_LEN_DECL);
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 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	164
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	165
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	166 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	167 static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	168 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	169
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	170 static octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	171 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	172 ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	173
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	174 static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	175 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	176
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	177 static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	178 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	179
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	180 static ComplexMatrix
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	181 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	182 const ComplexMatrix&);
8417 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 static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	185 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	186
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	187 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	188 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	189
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	190 static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	191 ltsolve (const Matrix&, const ColumnVector&, const Matrix&,);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	192
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	193 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	194 utsolve (const SparseComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	195
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	196 static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	197 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	198
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	199 static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	200 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	201
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	202 static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	203 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	204
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	205 #endif
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	206
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	207 template <class M, class SM>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	208 static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	209 lusolve (const SM& L, const SM& U, M& m)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	210 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	211 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	212 double rcond;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	213 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	214
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	215 // 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	216 m = L.solve (m, err, rcond, 0);
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 return err;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	219
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	220 m = U.solve (utyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	221
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	222 return err;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	223 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	224
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	225 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	226 static M
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	227 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	228 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	229 octave_idx_type n = L.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	230 octave_idx_type b_nc = m.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	231 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	232 double rcond;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	233 MatrixType ltyp (MatrixType::Lower);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	234 M tmp = L.solve (ltyp, m, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	235 M retval;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	236 const double* qv = Q.fortran_vec();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	237
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	238 if (!err)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	239 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	240 retval.resize (n, b_nc);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	241 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	242 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	243 for (octave_idx_type i = 0; i < n; i++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	244 retval.elem(static_cast<octave_idx_type>(qv[i]), j) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	245 tmp.elem(i,j);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	246 }
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	249 return retval;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	250 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	251
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	252 template <class SM, class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	253 static M
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	254 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	255 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	256 octave_idx_type n = U.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	257 octave_idx_type b_nc = m.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	258 octave_idx_type err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	259 double rcond;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	260 MatrixType utyp (MatrixType::Upper);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	261
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	262 M retval (n, b_nc);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	263 const double* qv = Q.fortran_vec();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	264 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	265 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	266 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	267 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	268 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	269 return U.solve (utyp, retval, err, rcond, 0);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	270 }
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 static bool
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	273 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	274 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	275 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	276
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	277 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	278 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	279
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	280 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	281 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	282 y[m.ridx(i)] += m.data(i) * x[j];
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	283
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	284 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 Matrix& m, const double x, double y)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	289 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	290 octave_idx_type nr = m.rows ();
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 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	294 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	295 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	296 F77_CHAR_ARG_LEN (1)));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	297
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	298 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	299 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	300 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	301 ("eigs: unrecoverable error in dgemv");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	302 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	303 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	304 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	305 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	306 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	307
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	308 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	309 vector_product (const SparseComplexMatrix& m, const Complex* x,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	310 Complex* y)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	311 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	312 octave_idx_type nc = m.cols ();
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 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	315 y[j] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	316
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	317 for (octave_idx_type j = 0; j < nc; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	318 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	319 y[m.ridx(i)] += m.data(i) * x[j];
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	320
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	321 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 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	326 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	327 octave_idx_type nr = m.rows ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	328 octave_idx_type nc = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	329
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	330 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	331 nr, nc, 1.0, m.data (), nr,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	332 x, 1, 0.0, y, 1
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	333 F77_CHAR_ARG_LEN (1)));
8417 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 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	336 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	337 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	338 ("eigs: unrecoverable error in zgemv");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	339 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	340 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	341 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	342 return true;
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	345 static bool
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	346 make_cholb (Matrix& b, Matrix& bt, ColumnVector& permB)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	347 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	348 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	349 CHOL fact (b, info);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	350 octave_idx_type n = b.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	351
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	352 if (info != 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	353 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	354 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	355 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	356 bt = fact.chol_matrix ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	357 b = bt.transpose();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	358 permB = ColumnVector(n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	359 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	360 permB(i) = i;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	361 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	362 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	363 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	364
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	365 static bool
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	366 make_cholb (SparseMatrix& b, SparseMatrix& bt, ColumnVector& permB)
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 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	369 SparseCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	370
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	371 if (fact.P() != 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	372 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	373 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	374 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	375 b = fact.L();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	376 bt = b.transpose();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	377 permB = fact.perm() - 1.0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	378 return true;
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	382 static bool
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	383 make_cholb (ComplexMatrix& b, ComplexMatrix& bt, ColumnVector& permB)
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 ComplexCHOL fact (b, info);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	387 octave_idx_type n = b.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	388
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	389 if (info != 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	390 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	391 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	392 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	393 bt = fact.chol_matrix ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	394 b = bt.hermitian();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	395 permB = ColumnVector(n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	396 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	397 permB(i) = i;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	398 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	399 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	400 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	401
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	402 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	403 make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	404 ColumnVector& permB)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	405 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	406 octave_idx_type info;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	407 SparseComplexCHOL fact (b, info, false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	408
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	409 if (fact.P() != 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	410 return false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	411 else
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 b = fact.L();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	414 bt = b.hermitian();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	415 permB = fact.perm() - 1.0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	416 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	417 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	418 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	419
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	420 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	421 LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	422 bool cholB, const ColumnVector& permB, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	423 SparseMatrix &L, SparseMatrix &U, octave_idx_type *P,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	424 octave_idx_type *Q)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	425 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	426 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	427 octave_idx_type n = m.rows();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	428
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	429 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	430 SparseMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	431
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	432 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	433 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	434 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	435 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	436 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	437 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	438 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	439 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	440 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	441 tmp.xcidx(i) = i;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	442 tmp.xridx(i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	443 static_cast<octave_idx_type>(permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	444 tmp.xdata(i) = 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	445 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	446 tmp.xcidx(n) = n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	447
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	448 AminusSigmaB = AminusSigmaB - sigma * tmp *
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	449 b.transpose() * b * tmp.transpose();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	450 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	451 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	452 AminusSigmaB = AminusSigmaB - sigma *
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	453 b.transpose() * b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	454 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	455 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	456 AminusSigmaB = AminusSigmaB - sigma * b;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	457 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	458 else
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 SparseMatrix sigmat (n, n, n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	461
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	462 // Create sigma * speye(n,n)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	463 sigmat.xcidx (0) = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	464 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	465 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	466 sigmat.xdata(i) = sigma;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	467 sigmat.xridx(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	468 sigmat.xcidx(i+1) = i + 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	469 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	470
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	471 AminusSigmaB = AminusSigmaB - sigmat;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	472 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	473
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	474 SparseLU fact (AminusSigmaB);
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 L = fact.L ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	477 U = fact.U ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	478 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	479 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	480
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	481 for (octave_idx_type j = 0; j < n; j++)
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 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	484 Q[j] = Q2[j];
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	485 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	486
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	487 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	488 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	489 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	490 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	491 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	492 double d = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	493 if (U.xcidx(j+1) > U.xcidx(j) &&
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	494 U.xridx (U.xcidx(j+1)-1) == j)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	495 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	496
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	497 if (xisnan (minU) \|\| d < minU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	498 minU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	499
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	500 if (xisnan (maxU) \|\| d > maxU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	501 maxU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	502 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	503
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	504 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	505 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	506
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	507 if (rcond_plus_one == 1.0 \|\| xisnan (rcond))
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 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	510 ("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	511 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	512 (" an eigenvalue. Convergence is not guaranteed");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	513 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	514
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	515 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	516 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	517
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	518 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	519 LuAminusSigmaB (const Matrix &m, const Matrix &b,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	520 bool cholB, const ColumnVector& permB, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	521 Matrix &L, Matrix &U, octave_idx_type *P,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	522 octave_idx_type *Q)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	523 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	524 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	525 octave_idx_type n = m.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	526
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	527 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	528 Matrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	529
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	530 if (have_b)
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 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	533 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	534 Matrix tmp = sigma * b.transpose() * b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	535 const double *pB = permB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	536 double *p = AminusSigmaB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	537
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	538 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	539 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	540 for (octave_idx_type j = 0;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	541 j < b.cols(); j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	542 for (octave_idx_type i = 0;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	543 i < b.rows(); i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	544 *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	545 static_cast<octave_idx_type>(pB[j]));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	546 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	547 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	548 AminusSigmaB = AminusSigmaB - tmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	549 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	550 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	551 AminusSigmaB = AminusSigmaB - sigma * b;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	552 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	553 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	554 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	555 double *p = AminusSigmaB.fortran_vec();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	556
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	557 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	558 p[i*(n+1)] -= sigma;
8417 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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	561 LU fact (AminusSigmaB);
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 L = fact.P().transpose() * fact.L ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	564 U = fact.U ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	565 for (octave_idx_type j = 0; j < n; j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	566 P[j] = Q[j] = j;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	567
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	568 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	569 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	570 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	571 for (octave_idx_type j = 0; j < n; j++)
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 double d = std::abs (U.xelem(j,j));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	574 if (xisnan (minU) \|\| d < minU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	575 minU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	576
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	577 if (xisnan (maxU) \|\| d > maxU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	578 maxU = d;
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	581 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	582 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	583
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	584 if (rcond_plus_one == 1.0 \|\| xisnan (rcond))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	585 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	586 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	587 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	588 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	589 (" an eigenvalue. Convergence is not guaranteed");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	590 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	591
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	592 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	593 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	594
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	595 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	596 LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	597 bool cholB, const ColumnVector& permB, Complex sigma,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	598 SparseComplexMatrix &L, SparseComplexMatrix &U,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	599 octave_idx_type P, octave_idx_type Q)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	600 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	601 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	602 octave_idx_type n = m.rows();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	603
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	604 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	605 SparseComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	606
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	607 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	608 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	609 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	610 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	611 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	612 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	613 SparseMatrix tmp(n,n,n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	614 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	615 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	616 tmp.xcidx(i) = i;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	617 tmp.xridx(i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	618 static_cast<octave_idx_type>(permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	619 tmp.xdata(i) = 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	620 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	621 tmp.xcidx(n) = n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	622
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	623 AminusSigmaB = AminusSigmaB - tmp * b.hermitian() * b *
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	624 tmp.transpose() * sigma;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	625 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	626 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	627 AminusSigmaB = AminusSigmaB - sigma * b.hermitian() * b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	628 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	629 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	630 AminusSigmaB = AminusSigmaB - sigma * b;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	631 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	632 else
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 SparseComplexMatrix sigmat (n, n, n);
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 // Create sigma * speye(n,n)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	637 sigmat.xcidx (0) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	638 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	639 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	640 sigmat.xdata(i) = sigma;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	641 sigmat.xridx(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	642 sigmat.xcidx(i+1) = i + 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	643 }
8417 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 AminusSigmaB = AminusSigmaB - sigmat;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	646 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	647
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	648 SparseComplexLU fact (AminusSigmaB);
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 L = fact.L ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	651 U = fact.U ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	652 const octave_idx_type *P2 = fact.row_perm ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	653 const octave_idx_type *Q2 = fact.col_perm ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	654
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	655 for (octave_idx_type j = 0; j < n; j++)
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 P[j] = P2[j];
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	658 Q[j] = Q2[j];
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	661 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	662 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	663 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	664 for (octave_idx_type j = 0; j < n; j++)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	665 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	666 double d = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	667 if (U.xcidx(j+1) > U.xcidx(j) &&
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	668 U.xridx (U.xcidx(j+1)-1) == j)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	669 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	670
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	671 if (xisnan (minU) \|\| d < minU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	672 minU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	673
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	674 if (xisnan (maxU) \|\| d > maxU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	675 maxU = d;
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	678 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	679 volatile double rcond_plus_one = rcond + 1.0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	680
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	681 if (rcond_plus_one == 1.0 \|\| xisnan (rcond))
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 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	684 ("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	685 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	686 (" an eigenvalue. Convergence is not guaranteed");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	687 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	688
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	689 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	690 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	691
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	692 static bool
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	693 LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	694 bool cholB, const ColumnVector& permB, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	695 ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	696 octave_idx_type *Q)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	697 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	698 bool have_b = ! b.is_empty ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	699 octave_idx_type n = m.cols();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	700
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	701 // Caclulate LU decomposition of 'A - sigma * B'
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	702 ComplexMatrix AminusSigmaB (m);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	703
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	704 if (have_b)
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 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	707 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	708 ComplexMatrix tmp = sigma * b.hermitian() * b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	709 const double *pB = permB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	710 Complex *p = AminusSigmaB.fortran_vec();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	711
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	712 if (permB.length())
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	713 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	714 for (octave_idx_type j = 0;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	715 j < b.cols(); j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	716 for (octave_idx_type i = 0;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	717 i < b.rows(); i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	718 *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	719 static_cast<octave_idx_type>(pB[j]));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	720 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	721 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	722 AminusSigmaB = AminusSigmaB - tmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	723 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	724 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	725 AminusSigmaB = AminusSigmaB - sigma * b;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	726 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	727 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	728 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	729 Complex *p = AminusSigmaB.fortran_vec();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	730
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	731 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	732 p[i*(n+1)] -= sigma;
8417 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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	735 ComplexLU fact (AminusSigmaB);
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 L = fact.P().transpose() * fact.L ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	738 U = fact.U ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	739 for (octave_idx_type j = 0; j < n; j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	740 P[j] = Q[j] = j;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	741
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	742 // Test condition number of LU decomposition
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	743 double minU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	744 double maxU = octave_NaN;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	745 for (octave_idx_type j = 0; j < n; j++)
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 double d = std::abs (U.xelem(j,j));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	748 if (xisnan (minU) \|\| d < minU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	749 minU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	750
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	751 if (xisnan (maxU) \|\| d > maxU)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	752 maxU = d;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	753 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	754
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	755 double rcond = (minU / maxU);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	756 volatile double rcond_plus_one = rcond + 1.0;
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 if (rcond_plus_one == 1.0 \|\| xisnan (rcond))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	759 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	760 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	761 ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly");
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	762 (*current_liboctave_warning_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	763 (" an eigenvalue. Convergence is not guaranteed");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	764 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	765
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	766 return true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	767 }
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 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	770 octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	771 EigsRealSymmetricMatrix (const M& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	772 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	773 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	774 ColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	775 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	776 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	777 bool cholB, int disp, int maxit)
8417 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 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	780 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	781 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	782 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	783 bool note3 = false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	784 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	785 double sigma = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	786 M bt;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	787
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	788 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	789 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	790 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	791 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	792 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	793 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	794 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	795 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	796 ("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	797 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	798 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	799
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	800 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	801 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	802 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	803 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	804 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	805 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	808 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	809 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	810 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	811 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	812 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	813 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	814
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	815 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	816 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	817 p = k * 2;
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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	820 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	821
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	822 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	823 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	824 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	825
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	826 if (k < 1 \|\| k > n - 2)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	827 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	828 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	829 ("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	830 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	831 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	832 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	833
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	834 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	835 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	836 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	837 ("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	838 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	839 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	840
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	841 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	842 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	843 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	844 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	845 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	846 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	847 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	848 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	849 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	850 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	851 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	852 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	853 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	854 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	855 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	856 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	857 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	858 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	859 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	860 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	861 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	862 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	863 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	864 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	865 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	866 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	867
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	868 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	869 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	870 typ != "SI")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	871 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	872 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	873 ("eigs: unrecognized sigma value");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	874 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	875 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	876
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	877 if (typ == "LI" \|\| typ == "SI" \|\| typ == "LR" \|\| typ == "SR")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	878 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	879 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	880 ("eigs: invalid sigma value for real symmetric problem");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	881 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	882 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	883
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	884 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	885 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	886 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	887 note3 = true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	888 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	889 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	890 bt = b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	891 b = b.transpose();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	892 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	893 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	894 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	895 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	896 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	897 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	898 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	899 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	900 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	901 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	902 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	903 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	904 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	905 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	906 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	907 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	908 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	909
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	910 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	911 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	912
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	913 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	914 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	915 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	916 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	917 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	918 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	919 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	920 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	921 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	922 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	923 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	924 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	925
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	926 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	927 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	928
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	929 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	930 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	931 octave_idx_type lwork = p * (p + 8);
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 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	934 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	935 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	936 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	937
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	938 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	939 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	940 F77_FUNC (dsaupd, DSAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	941 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	942 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	943 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	944 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	945 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	946
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	947 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	948 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	949 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	950 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	951 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	952 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	953
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	954 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	955 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	956 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	957 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	958 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	959 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	960 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	961 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	962 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	963 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	964
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	965 // 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	966 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	967 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	968 // 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	969 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	970 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	971 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	972 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	973
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	974 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	975 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	976 if (have_b)
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 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	979 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	980 mtmp(i,0) = workd[i + iptr(0) - 1];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	981
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	982 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	983
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	984 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	985 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	986 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	987 else if (!vector_product (m, workd + iptr(0) - 1,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	988 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	989 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	990 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	991 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	992 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	993 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	994 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	995 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	996 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	997 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	998 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	999 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1000 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1001 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1002 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1003
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1004 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1005
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1006 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1007 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1008 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1009 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1010 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1011 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1012 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1013 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	1014 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	1015
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1016 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1017 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1018
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1019 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1020 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1021
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1022 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1023 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1024 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1025 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1026 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1027 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1028
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1029 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1030 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1031 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1032 ("eigs: unrecoverable exception encountered in dseupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1033 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1034 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1035 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1036 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1037 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1038 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1039 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1040 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1041 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1042 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1043 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1044 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1045 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1046 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1047 }
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
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1050 if (rvec)
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 if (typ != "SM" && typ != "BE")
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 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1055
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1056 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1057 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1058 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1059 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1060
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1061 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1062 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1063
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1064 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1065 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1066
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1067 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1068 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1069
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1070 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1071 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1072 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1073 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1074
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1075 if (note3)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1076 eig_vec = ltsolve(b, permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1077 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1078 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1079 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1080 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1081 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1082 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1083 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1084 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1085 }
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 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1088 }
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 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1091 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1092 EigsRealSymmetricMatrixShift (const M& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1093 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1094 octave_idx_type &info, Matrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1095 ColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1096 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1097 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1098 bool cholB, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1099 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1100 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1101 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1102 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1103 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1104 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1105
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1106 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1107 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1108 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1109 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1110 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1111 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	1112 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 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: 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	1115 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1116 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1117
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1118 // 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	1119 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1120 // 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	1121 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1122 // disp, maxit);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1123
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1124 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1125 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1126 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1127 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1128 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1129 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1130 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1131
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1132 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1133 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1134 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1135 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1136 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1137 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1138
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1139 if (k <= 0 \|\| k >= n - 1)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1140 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1141 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1142 ("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	1143 " Use 'eig(full(A))' instead");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1144 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1145 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1146
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1147 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1148 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1149 p = k * 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1150
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1151 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1152 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1153
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1154 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1155 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1156 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1157
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1158 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1159 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1160 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1161 ("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	1162 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1163 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1164
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1165 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1166 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1167 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1168 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1169 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1170 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1171 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1172 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1173 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1174 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1175 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1176 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1177 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1178 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1179 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1180 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1181 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1182 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1183 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1184 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1185 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1186 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1187 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1188 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1189 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1190
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1191 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1192 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1193 bmat = 'G';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1194
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1195 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1196 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1197
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1198 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1199 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1200 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1201 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1202 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	1203 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1204 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1205 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1206 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1207 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1208 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1209 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1210
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1211 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1212 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1213
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1214 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1215 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1216 M L, U;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1217
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1218 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	1219 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	1220
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1221 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	1222 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1223
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1224 octave_idx_type lwork = p * (p + 8);
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 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1227 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1228 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1229 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1230
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1231 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1232 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1233 F77_FUNC (dsaupd, DSAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1234 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1235 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1236 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1237 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1238 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	1239
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1240 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1241 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1242 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1243 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1244 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1245 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1246
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1247 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1248 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1249 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1250 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1251 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1252 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1253 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1254 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1255 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1256 }
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 // 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	1259 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1260 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1261 // 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	1262 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1263 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1264 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1265 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1266
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1267 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1268 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1269 if (have_b)
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 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1272 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1273 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1274
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1275 vector_product (m, workd+iptr(0)-1, dtmp);
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 Matrix tmp(n, 1);
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1280 tmp(i,0) = dtmp[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1281
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1282 lusolve (L, U, tmp);
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 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1285 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1286 ip2[Q[i]] = tmp(i,0);
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 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1289 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	1290 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1291 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1292 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1293 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1294
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1295 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1296 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1297
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1298 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1299
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1300 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1301 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1302 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1303 }
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 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1306 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1307 if (ido == 2)
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1310 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	1311 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1312 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1313 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1314 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1315 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1316
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1317 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1318 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1319
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1320 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1321
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1322 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1323 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1324 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1325 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1326 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1327 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1328 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1329 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1330 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1331 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1332 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1333 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1334 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1335 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1336 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1337 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1338 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1339 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1340
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1341 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1342
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1343 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1344 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1345 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1346 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1347 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1348 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1349 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1350 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	1351 octave_idx_type *sel = s.fortran_vec ();
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1352
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1353 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1354 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1355
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1356 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1357 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1358
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1359 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1360 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1361 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1362 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1363 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	1364 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	1365
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1366 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1367 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1368 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1369 ("eigs: unrecoverable exception encountered in dseupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1370 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1371 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1372 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1373 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1374 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1375 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1376 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1377 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1378 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1379 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1380 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1381 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1382 }
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 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1385 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1386 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
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 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1389 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1390 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1391 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1392
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1393 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1394 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1395
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1396 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1397 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1398
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1399 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1400 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1401
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1402 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1403 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1404 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1405 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1406 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1407 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1408 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1409 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1410 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1411 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1412 }
8417 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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1415 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1416 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1417
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1418 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1419 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1420 const std::string &_typ, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1421 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1422 octave_idx_type &info, Matrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1423 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	1424 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1425 bool /* cholB */, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1426 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1427 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1428 bool have_sigma = (sigma ? true : false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1429 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1430 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1431 int err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1432
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1433 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1434 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1435 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1436 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1437 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1438 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1441 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1442 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1443 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1444 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1445 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1446 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1447
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1448 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1449 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1450 p = k * 2;
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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1453 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1454
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1455 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1456 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1457 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1458
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1459 if (k <= 0 \|\| k >= n - 1)
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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1462 ("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	1463 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1464 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1465 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1466
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1467 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1468 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1469 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1470 ("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	1471 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1472 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1473
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1474 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1475 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1476 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	1477 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1478 typ != "SI")
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1479 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1480 ("eigs: unrecognized sigma value");
8417 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 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	1483 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1484 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1485 ("eigs: invalid sigma value for real symmetric problem");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1486 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1487 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1488
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1489 if (typ == "SM")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1490 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1491 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1492 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1493 mode = 3;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1494 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1495 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1496 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1497 typ = "SM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1498 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1499 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1500 typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1501 mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1502 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1503
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1504 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1505 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1506
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1507 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1508 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1509 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1510 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1511 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	1512 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1513 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1514 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1515 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1516 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1517 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1518 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1519
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1520 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1521 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1522
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1523 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1524 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1525 octave_idx_type lwork = p * (p + 8);
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 OCTAVE_LOCAL_BUFFER (double, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1528 OCTAVE_LOCAL_BUFFER (double, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1529 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1530 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1531
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1532 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1533 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1534 F77_FUNC (dsaupd, DSAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1535 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1536 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1537 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1538 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1539 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	1540
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1541 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1542 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1543 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1544 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1545 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1546 }
8417 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 (disp > 0 && !xisnan(workl[iptr(5)-1]))
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 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1551 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1552 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1553 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1554 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1555 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1556 os << " " << workl[iptr(5)+i-1] << "\n";
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
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1559 // 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	1560 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1561 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1562 // 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	1563 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1564 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1565 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1566 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1567
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1568
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1569 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1570 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1571 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1572 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1573
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1574 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1575 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1576
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1577 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1578
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1579 if (err)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1580 return false;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1581
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1582 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1583 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1584 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1585 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1586 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1587 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1588 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1589 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1590 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1591 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1592 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1593 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1594 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1595 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1596 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1597 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1598
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1599 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1600
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1601 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1602 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1603 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1604 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1605 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1606 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1607 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1608 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	1609 octave_idx_type *sel = s.fortran_vec ();
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1610
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1611 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1612 double *z = eig_vec.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1613
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1614 eig_val.resize (k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1615 double *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1616
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1617 F77_FUNC (dseupd, DSEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1618 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, d, z, n, sigma,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1619 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1620 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1621 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	1622 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	1623
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1624 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1625 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1626 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1627 ("eigs: unrecoverable exception encountered in dseupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1628 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1629 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1630 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1631 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1632 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1633 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1634 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1635 if (typ != "SM" && typ != "BE")
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1636 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1637 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1638 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1639 double dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1640 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1641 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1642 }
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
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1645 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1646 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1647 if (typ != "SM" && typ != "BE")
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 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1650
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1651 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1652 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1653 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1654 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1655
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1656 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1657 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1658
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1659 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1660 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1661
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1662 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1663 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1664
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1665 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1666 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1667 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1668 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1669 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1670 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1671 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1672 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1673 (*current_liboctave_error_handler)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1674 ("eigs: error %d in dseupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1675 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1676 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1677 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1678
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1679 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1682 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1683 octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1684 EigsRealNonSymmetricMatrix (const M& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1685 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1686 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1687 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1688 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1689 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1690 bool cholB, int disp, int maxit)
8417 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 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1693 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1694 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1695 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1696 bool note3 = false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1697 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1698 double sigmar = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1699 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1700 M bt;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1701
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1702 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1703 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1704 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1705 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1706 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1707 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	1708 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1709 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1710 ("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	1711 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1712 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1713
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1714 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1715 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1716 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1717 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1718 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1719 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1722 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1723 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1724 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1725 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1726 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1727 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1728
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1729 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1730 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1731 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1734 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1735
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1736 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1737 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1738 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1739
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1740 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1741 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1742 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1743 ("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	1744 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1745 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1746 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1747
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	1748 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1749 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1750 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1751 ("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	1752 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1753 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1754
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1755 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1756 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1757 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1758 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1759 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1760 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1761 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1762 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1763 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1764 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1765 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1766 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1767 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1768 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1769 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1770 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1771 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1772 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1773 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1774 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1775 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1776 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1777 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1778 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1779 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1780 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1781
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1782 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1783 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1784 typ != "SI")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1785 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1786 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1787 ("eigs: unrecognized sigma value");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1788 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1789 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1790
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1791 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1792 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1793 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1794 ("eigs: invalid sigma value for unsymmetric problem");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1795 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1796 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1797
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1798 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1799 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1800 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1801 note3 = true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1802 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1803 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1804 bt = b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1805 b = b.transpose();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1806 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1807 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1808 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1809 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1810 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1811 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1812 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1813 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1814 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1815 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1816 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1817 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1818 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1819 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1820 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1821 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1822 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1823
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1824 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1825 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1826
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1827 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1828 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1829 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1830 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1831 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	1832 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1833 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1834 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1835 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1836 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1837 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1838 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1839
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1840 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1841 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1842
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1843 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1844 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1845 octave_idx_type lwork = 3 * p * (p + 2);
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 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1848 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1849 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1850 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1851
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1852 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1853 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1854 F77_FUNC (dnaupd, DNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1855 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1856 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1857 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1858 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1859 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	1860
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1861 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1862 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1863 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1864 ("eigs: unrecoverable exception encountered in dnaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1865 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1866 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1867
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1868 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1869 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1870 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1871 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1872 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1873 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1874 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1875 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1876 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1877 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1878
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1879 // 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	1880 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1881 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1882 // 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	1883 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1884 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1885 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1886 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1887
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1888 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1889 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1890 if (have_b)
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 Matrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1893 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1894 mtmp(i,0) = workd[i + iptr(0) - 1];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1895
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1896 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1897
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1898 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1899 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1900 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1901 else if (!vector_product (m, workd + iptr(0) - 1,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1902 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1903 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1904 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1905 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1906 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1907 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1908 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1909 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1910 ("eigs: error %d in dnaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1911 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1912 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1913 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1914 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1915 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1916 while (1);
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 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1919
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1920 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1921 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1922 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1923 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1924 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1925 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1926 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	1927 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	1928 octave_idx_type *sel = s.fortran_vec ();
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1929
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1930 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1931 double *z = eig_vec2.fortran_vec ();
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 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1934 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1935 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1936 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	1937 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1938
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1939 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1940 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1941 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1942 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1943 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1944 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1945
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1946 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1947 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1948 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1949 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1950 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1951 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1952 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1953 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1954 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1955 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1956
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1957 if (info2 == 0)
10314 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 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1960 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	1961 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1962 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	1963 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1964 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1965 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1966 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1967 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1968 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1969 d[i] = d[i+1];
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 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1972 for (octave_idx_type i = 0; i < k2; i++)
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 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1975 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1976 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1977 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1978 eig_val.resize(k);
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 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1981 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1982 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1983
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1984 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1985 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1986 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1987 octave_idx_type off2 = (k - i - 1) * n;
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 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1990 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1991
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1992 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1993 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1994
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1995 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1996 z[off1 + j] = z[off2 + 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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1999 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2000 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2001
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2002 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2003 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2004 while (i < k)
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 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2007 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2008 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2009 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2010 for (octave_idx_type j = 0; j < n; j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2011 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2012 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2013 i++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2014 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2015 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2016 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2017 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2018 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2019 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2020 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2021 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2022 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2023 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2024 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2025 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2026 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2027 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2028
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2029 if (note3)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2030 eig_vec = ltsolve(M (b), permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2031 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2032 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2033 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2034 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2035 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2036 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2037 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2038 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2039 }
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 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2044 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2045 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2046 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2047 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2048 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2049 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2050 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2051 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2052 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2053 bool cholB, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2054 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2055 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2056 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2057 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2058 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2059 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2060 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2061
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2062 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2063 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2064 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2065 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2066 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2067 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	2068 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 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: 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	2071 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2072 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2073
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2074 // 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	2075 //if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2076 // 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	2077 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2078 // disp, maxit);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2079
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2080 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2081 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2082 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2083 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2084 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2085 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2088 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2089 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2090 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2091 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2092 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2093 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2094
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2095 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2096 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2097 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2100 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2101
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2102 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2103 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2104 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2105
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2106 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2107 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2108 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2109 ("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	2110 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2111 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2112 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2113
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2114 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2115 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2116 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2117 ("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	2118 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2119 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2120
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2121 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2122 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2123 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2124 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2125 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2126 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2127 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2128 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2129 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2130 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2131 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2132 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2133 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2134 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2135 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2136 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2137 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2138 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2139 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2140 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2141 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2142 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2143 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2144 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2145 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2146
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2147 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2148 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2149 bmat = 'G';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2150
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2151 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2152 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2153
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2154 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2155 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2156 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2157 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2158 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	2159 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2160 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2161 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2162 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2163 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2164 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2165 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2166
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2167 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2168 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2169
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2170 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2171 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2172 M L, U;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2173
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2174 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	2175 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	2176
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2177 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	2178 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2179
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2180 octave_idx_type lwork = 3 * p * (p + 2);
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 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2183 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2184 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2185 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2186
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2187 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2188 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2189 F77_FUNC (dnaupd, DNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2190 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2191 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2192 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2193 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2194 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	2195
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2196 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2197 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2198 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2199 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2200 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2201 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2202
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2203 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2204 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2205 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2206 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2207 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2208 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2209 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2210 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2211 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2212 }
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 // 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	2215 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2216 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2217 // 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	2218 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2219 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2220 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2221 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2222
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2223 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2224 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2225 if (have_b)
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 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2228 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2229 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2230
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2231 vector_product (m, workd+iptr(0)-1, dtmp);
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 Matrix tmp(n, 1);
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2236 tmp(i,0) = dtmp[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2237
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2238 lusolve (L, U, tmp);
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 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2241 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2242 ip2[Q[i]] = tmp(i,0);
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 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2245 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	2246 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2247 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2248 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2249 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2250
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2251 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2252 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2253
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2254 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2255
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2256 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2257 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2258 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2259 }
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 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2262 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2263 if (ido == 2)
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2266 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	2267 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2268 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2269 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2270 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2271 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2272
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2273 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2274 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2275
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2276 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2277
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2278 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2279 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2280 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2281 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2282 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2283 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2284 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2285 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2286 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2287 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2288 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2289 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2290 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2291 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2292 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2293 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2294 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2295 while (1);
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 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2298
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2299 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2300 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2301 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2302 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2303 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2304 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2305 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2306 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	2307 octave_idx_type *sel = s.fortran_vec ();
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2308
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2309 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2310 double *z = eig_vec2.fortran_vec ();
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 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2313 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2314 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2315 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	2316 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2317
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2318 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2319 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2320 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2321 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2322 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2323 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2324
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2325 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2326 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2327 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2328 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2329 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2330 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2331 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2332 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2333 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2334 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2335
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2336 if (info2 == 0)
10314 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 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2339 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	2340 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2341 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	2342 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2343 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2344 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2345 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2346 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2347 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2348 d[i] = d[i+1];
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 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2351 for (octave_idx_type i = 0; i < k2; i++)
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 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2354 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2355 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2356 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2357 eig_val.resize(k);
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 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2360 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2361 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2362
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2363 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2364 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2365 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2366 octave_idx_type off2 = (k - i - 1) * n;
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 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2369 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2370
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2371 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2372 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2373
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2374 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2375 z[off1 + j] = z[off2 + 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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2378 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2379 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2380
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2381 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2382 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2383 while (i < k)
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 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2386 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2387 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2388 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2389 for (octave_idx_type j = 0; j < n; j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2390 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2391 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2392 i++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2393 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2394 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2395 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2396 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2397 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2398 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2399 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2400 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2401 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2402 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2403 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2404 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2405 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2406 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2407 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2408 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2409 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2410 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2411 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2412 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2413 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2414 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2415 }
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 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2418 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2419
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2420 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2421 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2422 const std::string &_typ, double sigmar,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2423 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2424 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2425 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	2426 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2427 bool /* cholB */, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2428 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2429 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2430 bool have_sigma = (sigmar ? true : false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2431 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2432 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2433 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2434 int err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2435
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2436 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2437 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2438 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2439 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2440 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2441 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2444 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2445 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2446 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2447 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2448 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2449 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2450
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2451 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2452 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2453 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2456 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2457
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2458 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2459 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2460 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2461
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2462 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2463 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2464 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2465 ("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	2466 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2467 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2468 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2469
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2470 if (p <= k \|\| p >= n)
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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2473 ("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	2474 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2475 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2476
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2477
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2478 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2479 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2480 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	2481 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2482 typ != "SI")
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2483 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2484 ("eigs: unrecognized sigma value");
8417 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 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2487 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2488 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2489 ("eigs: invalid sigma value for unsymmetric problem");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2490 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2491 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2492
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2493 if (typ == "SM")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2494 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2495 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2496 sigmar = 0.;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2497 mode = 3;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2498 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2499 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2500 else if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2501 typ = "SM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2502 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2503 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2504 typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2505 mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2506 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2507
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2508 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2509 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2510
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2511 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2512 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2513 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2514 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2515 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	2516 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2517 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2518 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2519 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2520 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2521 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2522 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2523
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2524 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2525 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2526
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2527 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2528 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2529 octave_idx_type lwork = 3 * p * (p + 2);
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 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2532 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2533 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2534 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2535
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2536 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2537 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2538 F77_FUNC (dnaupd, DNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2539 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2540 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2541 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2542 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2543 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	2544
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2545 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2546 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2547 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2548 ("eigs: unrecoverable exception encountered in dnaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2549 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2550 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2551
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2552 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2553 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2554 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2555 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2556 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2557 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2558 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2559 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2560 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2561 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2562
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2563 // 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	2564 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2565 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2566 // 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	2567 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2568 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2569 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2570 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2571
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2572 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2573 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2574 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2575 ColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2576
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2577 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2578 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2579
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2580 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2581
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2582 if (err)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2583 return false;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2584
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2585 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2586 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2587 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2588 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2589 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2590 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2591 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2592 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2593 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2594 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2595 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2596 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2597 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2598 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2599 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2600 while (1);
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 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2603
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2604 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2605 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2606 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2607 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2608 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2609 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2610 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2611 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	2612 octave_idx_type *sel = s.fortran_vec ();
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2613
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2614 Matrix eig_vec2 (n, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2615 double *z = eig_vec2.fortran_vec ();
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 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2618 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2619 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2620 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	2621 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2622
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2623 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2624 (rvec, F77_CONST_CHAR_ARG2 ("A", 1), sel, dr, di, z, n, sigmar,
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2625 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2626 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2), k, tol, presid, p, v, n, iparam,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2627 ipntr, workd, workl, lwork, info2 F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2628 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2629
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2630 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2631 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2632 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2633 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2634 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2635 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2636 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2637 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2638 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2639 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2640
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2641 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2642 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2643 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2644 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	2645 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2646 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	2647 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2648 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2649 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2650 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2651 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2652 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2653 d[i] = d[i+1];
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 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2656 for (octave_idx_type i = 0; i < k2; i++)
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 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2659 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2660 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2661 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2662 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2663
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2664 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2665 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2666 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2667
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2668 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2669 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2670 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2671 octave_idx_type off2 = (k - i - 1) * n;
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 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2674 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2675
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2676 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2677 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2678
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2679 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2680 z[off1 + j] = z[off2 + 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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2683 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2684 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2685
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2686 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2687 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2688 while (i < k)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2689 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2690 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2691 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2692 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2693 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2694 for (octave_idx_type j = 0; j < n; j++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2695 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2696 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2697 i++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2698 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2699 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2700 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2701 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2702 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2703 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2704 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2705 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2706 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2707 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2708 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2709 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2710 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2711 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2712 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2713 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2714 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2715 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2716 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2717 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2718 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2719 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2720 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2721
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2722 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2725 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2726 octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2727 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2728 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2729 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2730 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2731 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2732 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2733 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2734 bool cholB, int disp, int maxit)
8417 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 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2737 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2738 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2739 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2740 bool note3 = false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2741 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2742 Complex sigma = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2743 M bt;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2744
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2745 if (m.rows() != m.cols())
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 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2748 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2749 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2750 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	2751 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2752 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2753 ("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	2754 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2755 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2756
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2757 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2760 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2761 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2762 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2763 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2764 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	2765 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2766 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2769 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2770 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2771 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2772 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2773 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2774 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2775
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2776 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2777 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2778 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2781 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2782
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2783 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2784 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2785 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2786
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2787 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2788 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2789 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2790 ("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	2791 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2792 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2793 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2794
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2795 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2796 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2797 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2798 ("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	2799 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2800 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2801
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2802 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2803 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2804 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2805 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2806 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2807 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2808 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2809 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2810 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2811 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2812 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2813 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2814 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2815 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2816 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2817 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2818 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2819 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2820 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2821 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2822 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2823 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2824 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2825 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2826 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2827 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2828
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2829 if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" &&
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2830 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2831 typ != "SI")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2832 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2833 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2834 ("eigs: unrecognized sigma value");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2835 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2836 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2837
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2838 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2839 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2840 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2841 ("eigs: invalid sigma value for complex problem");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2842 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2843 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2844
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2845 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2846 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2847 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2848 note3 = true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2849 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2850 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2851 bt = b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2852 b = b.hermitian();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2853 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2854 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2855 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2856 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2857 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2858 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2859 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2860 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2861 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2862 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2863 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2864 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2865 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2866 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2867 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2868 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2869 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2870
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2871 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2872 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2873
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2874 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2875 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2876 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2877 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2878 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	2879 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2880 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2881 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2882 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2883 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2884 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2885 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2886
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2887 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2888 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2889
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2890 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2891 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2892 octave_idx_type lwork = p * (3 * p + 5);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2893
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2894 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2895 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2896 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2897 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2898 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2899
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2900 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2901 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2902 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2903 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2904 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2905 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2906 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2907 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	2908
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2909 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2910 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2911 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2912 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2913 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2914 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2915
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2916 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2917 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2918 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2919 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2920 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2921 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2922 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2923 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2924 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2925 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2926
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2927 // 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	2928 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2929 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2930 // 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	2931 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2932 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2933 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2934 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2935
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2936 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2937 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2938 if (have_b)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2939 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2940 ComplexMatrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2941 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2942 mtmp(i,0) = workd[i + iptr(0) - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2943 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2944 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2945 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2946
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2947 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2948 else if (!vector_product (m, workd + iptr(0) - 1,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2949 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2950 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2951 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2952 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2953 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2954 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2955 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2956 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2957 ("eigs: error %d in znaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2958 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2959 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2960 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2961 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2962 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2963 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2964
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2965 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2966
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2967 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2968 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2969 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2970 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2971 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2972 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2973 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2974 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	2975 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2978 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2981 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2982
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2983 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2984
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2985 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2986 (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	2987 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2988 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2989 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	2990 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	2991
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2992 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2993 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2994 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2995 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2996 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2997 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2998
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2999 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3000 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3001 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3002 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	3003 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3004 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3005 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3006 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3007 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3008 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3009
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3010 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3011 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3012 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3013
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3014 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3015 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3016 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3017 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3018
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3019 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3020 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3021
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3022 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3023 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3024
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3025 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3026 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3027
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3028 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3029 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3030 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3031
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3032 if (note3)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3033 eig_vec = ltsolve(b, permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3034 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3035 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3036 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3037 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3038 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3039 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3040 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3041 }
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 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3046 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3047 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3048 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3049 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3050 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3051 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3052 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3053 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3054 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3055 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3056 bool cholB, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3057 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3058 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3059 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3060 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3061 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3062 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3063
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3064 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3065 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3066 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3067 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3068 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3069 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	3070 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3071 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3072 ("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	3073 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3074 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3075
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3076 // 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	3077 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3078 // 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	3079 // eig_val, _b, permB, cresid, os, tol,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3080 // rvec, cholB, disp, maxit);
8417 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 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3085 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3086 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3087 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3088 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3089 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	3090 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3091 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3094 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3095 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3096 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3097 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3098 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3099 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3100
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3101 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3102 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3103 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3106 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3107
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3108 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3109 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3110 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3111
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3112 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3113 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3114 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3115 ("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	3116 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3117 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3118 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3119
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3120 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3121 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3122 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3123 ("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	3124 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3125 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3126
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3127 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3128 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3129 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3130 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3131 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3132 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3133 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3134 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3135 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3136 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3137 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3138 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3139 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3140 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3141 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3142 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3143 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3144 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3145 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3146 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3147 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3148 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3149 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3150 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3151 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3152
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3153 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3154 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3155 bmat = 'G';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3156
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3157 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3158 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3159
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3160 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3161 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3162 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3163 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3164 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	3165 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3166 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3167 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3168 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3169 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3170 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3171 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3172
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3173 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3174 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3175
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3176 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3177 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3178 M L, U;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3179
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3180 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	3181 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	3182
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3183 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	3184 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3185
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3186 octave_idx_type lwork = p * (3 * p + 5);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3187
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3188 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3189 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3190 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3191 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3192 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3193
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3194 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3195 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3196 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3197 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3198 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3199 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3200 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3201 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	3202
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3203 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3204 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3205 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3206 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3207 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3208 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3209
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3210 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3211 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3212 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3213 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3214 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3215 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3216 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3217 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3218 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3219 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3220
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3221 // 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	3222 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3223 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3224 // 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	3225 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3226 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3227 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3228 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3229
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3230 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3231 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3232 if (have_b)
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 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3235 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3236 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3237
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3238 vector_product (m, workd+iptr(0)-1, ctmp);
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 ComplexMatrix tmp(n, 1);
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3243 tmp(i,0) = ctmp[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3244
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3245 lusolve (L, U, tmp);
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 Complex *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3248 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3249 ip2[Q[i]] = tmp(i,0);
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 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3252 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	3253 else
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 Complex *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3256 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3257
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3258 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3259 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3260
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3261 lusolve (L, U, tmp);
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 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3264 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3265 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3266 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3267 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3268 else
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 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3271 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3272 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3273 workd[iptr(0) + i - 1] =
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3274 workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3275 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3276 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3277 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3278 Complex *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3279 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3280
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3281 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3282 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3283
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3284 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3285
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3286 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3287 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3288 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3289 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3290 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3291 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3292 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3293 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3294 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3295 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3296 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3297 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3298 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3299 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3300 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3301 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3302 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3303 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3304
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3305 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3306
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3307 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3308 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3309 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3310 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3311 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3312 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3313 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3314 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	3315 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3318 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3321 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3322
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3323 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3324
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3325 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3326 (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	3327 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3328 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3329 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	3330 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	3331
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3332 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3333 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3334 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3335 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3336 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3337 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3338
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3339 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3340 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3341 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3342 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	3343 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3344 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3345 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3346 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3347 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3348 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3349
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3350 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3351 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3352 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3353
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3354 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3355 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3356 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3357 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3358
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3359 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3360 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3361
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3362 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3363 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3364
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3365 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3366 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3367
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3368 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3369 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3370 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3371 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3372 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3373 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3374 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3375 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3376 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3377 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3378 }
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 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3381 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3382
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3383 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3384 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3385 const std::string &_typ, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3386 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3387 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3388 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3389 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	3390 double tol, bool rvec, bool /* cholB */,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3391 int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3392 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3393 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3394 bool have_sigma = (std::abs(sigma) ? true : false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3395 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3396 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3397 int err = 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 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3402 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3403 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3404 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3405 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3406 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	3407 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3408 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3411 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3412 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3413 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3414 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3415 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3416 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3417
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3418 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3419 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3420 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3423 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3424
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3425 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3426 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3427 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3428
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3429 if (k <= 0 \|\| k >= n - 1)
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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3432 ("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	3433 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3434 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3435 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3436
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3437 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3438 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3439 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3440 ("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	3441 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3442 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3443
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3444 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3445 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3446 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	3447 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3448 typ != "SI")
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3449 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3450 ("eigs: unrecognized sigma value");
8417 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 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3453 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3454 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3455 ("eigs: invalid sigma value for complex problem");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3456 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3457 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3458
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3459 if (typ == "SM")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3460 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3461 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3462 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3463 mode = 3;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3464 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3465 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3466 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3467 typ = "SM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3468 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3469 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3470 typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3471 mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3472 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3473
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3474 Array<octave_idx_type> ip (dim_vector (11, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3475 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3476
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3477 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3478 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3479 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3480 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3481 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	3482 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3483 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3484 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3485 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3486 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3487 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3488 // ip(7) to ip(10) return values
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3489
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3490 Array<octave_idx_type> iptr (dim_vector (14, 1));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3491 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3492
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3493 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3494 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3495 octave_idx_type lwork = p * (3 * p + 5);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3496
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3497 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3498 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3499 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3500 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3501 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3502
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3503 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3504 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3505 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3506 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3507 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3508 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3509 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3510 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	3511
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3512 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3513 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3514 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3515 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3516 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3517 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3518
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3519 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3520 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3521 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3522 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3523 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3524 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3525 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3526 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3527 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3528 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3529
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3530 // 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	3531 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3532 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3533 // 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	3534 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3535 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3536 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3537 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3538
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3539 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3540 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3541 Complex *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3542 ComplexColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3543
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3544 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3545 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3546
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3547 ComplexColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3548
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3549 if (err)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3550 return false;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3551
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3552 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3553 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3554 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3555 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3556 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3557 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3558 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3559 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3560 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3561 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3562 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3563 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3564 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3565 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3566 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3567 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3568
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3569 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3570
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3571 // We have a problem in that the size of the C++ bool
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3572 // type relative to the fortran logical type. It appears
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3573 // that fortran uses 4- or 8-bytes per logical and C++ 1-byte
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3574 // per bool, though this might be system dependent. As
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3575 // long as the HOWMNY arg is not "S", the logical array
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3576 // is just workspace for ARPACK, so use int type to
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3577 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3578 Array<octave_idx_type> s (dim_vector (p, 1));
9391 333b31ce3434 eigs-base.cc: use octave_idx_type for Fortran LOGICAL values Alexander Barth <barth.alexander@gmail.com> parents: 9228 diff changeset	3579 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3582 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3585 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3586
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3587 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3588
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3589 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3590 (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	3591 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3592 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3593 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	3594 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	3595
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3596 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3597 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3598 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3599 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3600 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3601 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3602
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3603 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3604 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3605 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3606 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	3607 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3608 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3609 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3610 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3611 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3612 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3613
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3614 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3615 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3616 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3617
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3618 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3619 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3620 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3621 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3622
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3623 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3624 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3625
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3626 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3627 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3628
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3629 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3630 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3631
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3632 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3633 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3634 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3635 }
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 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3638 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3639 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3640 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3641 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3642 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3643
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3644 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3645 }
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 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3648 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3649 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3650 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3651 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3652 ColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3653 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3654 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	3655 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	3656 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3657
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3658 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3659 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3660 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3661 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3662 ColumnVector &eig_val, const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3663 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3664 std::ostream& os, double tol = DBL_EPSILON,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3665 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	3666 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3667
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3668 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3669 EigsRealSymmetricMatrixShift (const Matrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3670 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3671 octave_idx_type &info, Matrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3672 ColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3673 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3674 std::ostream &os, double tol = DBL_EPSILON,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3675 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	3676 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3677
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3678 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3679 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3680 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3681 octave_idx_type &info, Matrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3682 ColumnVector &eig_val, const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3683 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3684 std::ostream &os, double tol = DBL_EPSILON,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3685 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	3686 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3687
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3688 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3689 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3690 const std::string &typ, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3691 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3692 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3693 Matrix &eig_vec, ColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3694 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	3695 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3696 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	3697
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3698 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3699 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ,
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, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3702 ComplexColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3703 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3704 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	3705 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	3706 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3707
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3708 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3709 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3710 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3711 octave_idx_type &info, ComplexMatrix &eig_vec,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3712 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3713 const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3714 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3715 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	3716 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	3717 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3718
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3719 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3720 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3721 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3722 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3723 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3724 ComplexColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3725 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3726 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	3727 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	3728 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3729
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3730 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3731 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3732 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3733 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3734 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3735 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3736 const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3737 ColumnVector &permB, ColumnVector &resid,
10314 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,
b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	3740 int disp = 0, 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 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3744 const std::string &_typ, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3745 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3746 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3747 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3748 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	3749 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3750 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	3751
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3752 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3753 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3754 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3755 octave_idx_type &info, ComplexMatrix &eig_vec,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3756 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3757 const ComplexMatrix& b, ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3758 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3759 std::ostream &os, double tol = DBL_EPSILON,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3760 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	3761 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3762
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3763 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3764 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3765 const std::string typ, octave_idx_type k,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3766 octave_idx_type p, octave_idx_type &info,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3767 ComplexMatrix &eig_vec,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3768 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3769 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3770 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3771 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3772 std::ostream &os, double tol = DBL_EPSILON,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3773 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	3774 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3775
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3776 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3777 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3778 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3779 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3780 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3781 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3782 const ComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3783 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3784 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3785 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	3786 bool rvec = false, bool cholB = 0,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3787 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3788
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3789 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3790 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3791 Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3792 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3793 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3794 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3795 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3796 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3797 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3798 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3799 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	3800 bool rvec = false, bool cholB = 0,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3801 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3802
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3803 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3804 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3805 const std::string &_typ, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3806 octave_idx_type k, octave_idx_type p,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3807 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3808 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3809 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	3810 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3811 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	3812 #endif
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 #ifndef _MSC_VER
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3815 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3816 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3817
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3818 template static octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3819 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3820 ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3821
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3822 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3823 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3824
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3825 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3826 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3827
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3828 template static ComplexMatrix
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3829 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3830 const ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3831
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3832 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3833 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3834
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3835 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3836 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3837
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3838 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3839 ltsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3840
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3841 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3842 utsolve (const SparseComplexMatrix&, const ColumnVector&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3843 const ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3844
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3845 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3846 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3847
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3848 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3849 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3850
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3851 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3852 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3853 #endif
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3854
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3855 #endif

Mercurial > hg > octave-nkf

annotate liboctave/eigs-base.cc @ 11586:12df7854fa7c