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

annotate liboctave/eigs-base.cc @ 15536:2e8eb9ac43a5 stable rc-3-6-4-0

3.6.4-rc0 release candidate * configure.ac (AC_INIT): Version is now 3.6.2-rc0. (OCTAVE_RELEASE_DATE): Now 2012-05-11.

author	John W. Eaton <jwe@octave.org>
date	Wed, 17 Oct 2012 10:05:44 -0400
parents	834df9f10963
children	f5c3de9502b2

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
14138 72c96de7a403 maint: update copyright notices for 2012 John W. Eaton <jwe@octave.org> parents: 12202 diff changeset	3 Copyright (C) 2005-2012 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
14144 834df9f10963 remove ARPACK files from sources and restore configure checks for external ARPACK library John W. Eaton <jwe@octave.org> parents: 14138 diff changeset	47 #ifdef HAVE_ARPACK
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	48 typedef ColumnVector (*EigsFunc) (const ColumnVector &x, int &eigs_error);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	49 typedef ComplexColumnVector (*EigsComplexFunc)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	50 (const ComplexColumnVector &x, int &eigs_error);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	51
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	52 // Arpack and blas fortran functions we call.
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	53 extern "C"
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	54 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	55 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	56 F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	57 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	58 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	59 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	60 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	61 double, const octave_idx_type&, double,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	62 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	63 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	64 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	65 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	66 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	67
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	68 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	69 F77_FUNC (dseupd, DSEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	70 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	71 octave_idx_type, double, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	72 const octave_idx_type&, const double&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	73 F77_CONST_CHAR_ARG_DECL,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	74 const octave_idx_type&,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	75 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	76 const octave_idx_type&, const double&, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	77 const octave_idx_type&, double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	78 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	79 octave_idx_type, double, double*,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	80 const octave_idx_type&, octave_idx_type&
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	81 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	82 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	83 F77_CHAR_ARG_LEN_DECL);
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	84
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	85 F77_RET_T
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	86 F77_FUNC (dnaupd, DNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	87 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	88 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	89 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	90 octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	91 double, const octave_idx_type&, double,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	92 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	93 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	94 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	95 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	96 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	97
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	98 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	99 F77_FUNC (dneupd, DNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	100 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	101 octave_idx_type, double, double*,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	102 double*, const octave_idx_type&, const double&,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	103 const double&, double*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	104 F77_CONST_CHAR_ARG_DECL,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	105 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	106 F77_CONST_CHAR_ARG_DECL,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	107 octave_idx_type&, const double&, double*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	108 const octave_idx_type&, double*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	109 const octave_idx_type&, octave_idx_type*,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	110 octave_idx_type, double, double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	111 const octave_idx_type&, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	112 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	113 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	114 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	115
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	116 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	117 F77_FUNC (znaupd, ZNAUPD) (octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	118 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	119 const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	120 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	121 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	122 Complex, const octave_idx_type&, Complex,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	123 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	124 octave_idx_type, Complex, Complex*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	125 const octave_idx_type&, double *, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	126 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	127 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	128
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	129 F77_RET_T
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	130 F77_FUNC (zneupd, ZNEUPD) (const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	131 F77_CONST_CHAR_ARG_DECL,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	132 octave_idx_type, Complex, Complex*,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	133 const octave_idx_type&, const Complex&, Complex*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	134 F77_CONST_CHAR_ARG_DECL,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	135 const octave_idx_type&,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	136 F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	137 const octave_idx_type&, const double&,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	138 Complex, const octave_idx_type&, Complex,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	139 const octave_idx_type&, octave_idx_type*,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	140 octave_idx_type, Complex, Complex*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	141 const octave_idx_type&, double *, octave_idx_type&
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	142 F77_CHAR_ARG_LEN_DECL
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	143 F77_CHAR_ARG_LEN_DECL
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	144 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	145
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	146 F77_RET_T
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	147 F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL,
11518 141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	148 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	149 const double&, const double*,
141b3fb5cef7 style fixes John W. Eaton <jwe@octave.org> parents: 10466 diff changeset	150 const octave_idx_type&, const double*,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	151 const octave_idx_type&, const double&, double*,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	152 const octave_idx_type&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	153 F77_CHAR_ARG_LEN_DECL);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	154
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	155
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	156 F77_RET_T
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	157 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
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
12202 dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK John W. Eaton <jwe@octave.org> parents: 12198 diff changeset	205 #endif
dc72a664ac7a eigs-base.cc: fix error in change removing HAVE_ARPACK John W. Eaton <jwe@octave.org> parents: 12198 diff changeset	206
8417 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
12198 30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1930 // FIXME -- initialize eig_vec2 to zero; apparently dneupd can skip
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1931 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1932 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1933 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1934 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1935 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1936
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	1937 Matrix eig_vec2 (n, k + 1, 0.0);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1938 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1939
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1940 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1941 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1942 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1943 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	1944 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1945
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1946 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	1947 (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	1948 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1949 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	1950 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	1951 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1952
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1953 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1954 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1955 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1956 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1957 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1958 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1959 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1960 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1961 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1962 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1963
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	1964 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1965 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1966 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1967 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	1968 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1969 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	1970 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1971 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1972 d [i-jj] = Complex (dr[i], di[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 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1975 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1976 d[i] = d[i+1];
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 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1979 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1980 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1981 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1982 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1983 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1984 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1985 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1986
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1987 if (rvec)
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 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1990
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1991 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1992 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1993 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1994 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1995
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1996 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1997 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1998
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	1999 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2000 dtmp[j] = z[off1 + j];
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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2003 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2004
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2005 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2006 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2007 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2008
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2009 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2010 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2011 while (i < k)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2012 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2013 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2014 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2015 if (std::imag(eig_val(i)) == 0)
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++)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2018 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2019 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2020 i++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2021 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2022 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2023 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2024 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2025 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2026 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2027 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2028 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2029 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2030 Complex(z[j+off1],-z[j+off2]);
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 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2033 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2034 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2035
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2036 if (note3)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2037 eig_vec = ltsolve(M (b), permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2038 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2039 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2040 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2041 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2042 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2043 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2044 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2045 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2046 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2047
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2048 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2049 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2050
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2051 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2052 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2053 EigsRealNonSymmetricMatrixShift (const M& m, double sigmar,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2054 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	2055 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2056 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2057 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2058 ColumnVector &permB, ColumnVector &resid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2059 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2060 bool cholB, int disp, int maxit)
8417 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 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2063 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2064 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2065 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2066 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2067 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2068
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2069 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2070 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2071 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2072 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2073 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2074 if (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	2075 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2076 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2077 ("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	2078 return -1;
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2081 // 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	2082 //if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2083 // 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	2084 // _b, permB, resid, os, tol, rvec, cholB,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2085 // disp, maxit);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2086
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2087 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2088 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2089 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2090 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2091 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2092 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2093 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2094
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2095 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2096 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2097 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2098 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2099 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2100 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2101
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2102 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2103 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2104 p = k * 2 + 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2105
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2106 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2107 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2108
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2109 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2110 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2111 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2112
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2113 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2114 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2115 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2116 ("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	2117 " Use 'eig(full(A))' instead");
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2121 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2122 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2123 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2124 ("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	2125 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2126 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2127
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2128 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2129 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2130 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2131 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2132 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2133 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2134 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2135 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2136 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2137 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2138 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2139 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2140 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2141 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2142 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2143 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2144 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2145 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2146 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2147 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2148 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2149 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2150 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2151 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2152 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2153
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2154 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2155 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2156 bmat = 'G';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2157
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2158 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	2159 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2160
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2161 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2162 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2163 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2164 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2165 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	2166 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2167 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2168 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2169 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2170 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2171 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2172 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2173
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2174 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	2175 octave_idx_type *ipntr = iptr.fortran_vec ();
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 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2178 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2179 M L, U;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2180
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2181 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	2182 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	2183
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2184 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	2185 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2186
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2187 octave_idx_type lwork = 3 * p * (p + 2);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2188
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2189 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2190 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2191 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2192 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2193
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2194 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2195 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2196 F77_FUNC (dnaupd, DNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2197 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2198 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2199 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2200 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2201 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	2202
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2203 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2204 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2205 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2206 ("eigs: unrecoverable exception encountered in dsaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2207 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2208 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2209
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2210 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2211 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2212 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2213 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2214 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2215 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2216 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2217 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2218 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2219 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2220
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2221 // 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	2222 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2223 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2224 // 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	2225 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2226 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2227 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2228 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2229
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2230 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2231 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2232 if (have_b)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2233 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2234 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2235 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2236 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2237
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2238 vector_product (m, workd+iptr(0)-1, dtmp);
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 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2241
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2242 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2243 tmp(i,0) = dtmp[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2244
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2245 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2246
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2247 double *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2248 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2249 ip2[Q[i]] = tmp(i,0);
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 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2252 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	2253 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2254 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2255 double *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2256 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2257
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2258 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2259 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2260
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2261 lusolve (L, U, tmp);
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 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2264 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2265 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2266 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2267 }
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 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2271 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2272 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2273 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	2274 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2275 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2276 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2277 double *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2278 Matrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2279
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2280 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2281 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2282
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2283 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2284
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2285 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2286 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2287 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2288 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2289 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2290 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2291 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2292 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2293 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2294 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2295 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2296 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2297 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2298 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2299 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2300 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2301 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2302 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2303
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2304 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2305
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2306 // 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	2307 // 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	2308 // 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	2309 // 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	2310 // 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	2311 // 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	2312 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2313 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	2314 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	2315
12198 30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2316 // FIXME -- initialize eig_vec2 to zero; apparently dneupd can skip
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2317 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2318 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2319 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2320 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2321 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2322
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2323 Matrix eig_vec2 (n, k + 1, 0.0);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2324 double *z = eig_vec2.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2325
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2326 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2327 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2328 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2329 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	2330 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2331
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2332 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2333 (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	2334 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2335 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	2336 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	2337 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2338
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2339 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2340 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2341 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2342 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2343 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2344 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2345 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2346 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2347 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2348 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2349
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2350 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2351 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2352 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2353 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	2354 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2355 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	2356 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2357 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2358 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2359 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2360 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2361 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2362 d[i] = d[i+1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2363
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2364 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2365 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2366 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2367 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2368 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2369 d[k - i - 1] = dtmp;
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 eig_val.resize(k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2372
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2373 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2374 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2375 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
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 i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2378 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2379 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2380 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2381
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2382 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2383 continue;
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 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2386 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2387
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2388 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2389 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2390
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2391 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2392 z[off2 + j] = dtmp[j];
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
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2395 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2396 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2397 while (i < k)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2398 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2399 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2400 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2401 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2402 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2403 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	2404 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2405 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2406 i++;
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 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2409 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2410 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2411 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2412 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2413 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2414 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2415 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2416 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2417 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2418 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2419 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2420 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2421 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2422 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2423 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2424 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2425 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2426 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2427 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2428 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2429 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2430
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2431 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2432 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2433
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2434 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2435 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2436 const std::string &_typ, double sigmar,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2437 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	2438 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2439 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	2440 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2441 bool /* cholB */, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2442 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2443 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2444 bool have_sigma = (sigmar ? true : false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2445 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2446 double sigmai = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2447 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2448 int err = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2449
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2450 if (resid.is_empty())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2451 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2452 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2453 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2454 resid = ColumnVector (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2455 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2456 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2457
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2458 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2459 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2460 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2461 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2462 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2463 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2464
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2465 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2466 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2467 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2470 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2471
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2472 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2473 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2474 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2475
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2476 if (k <= 0 \|\| k >= n - 1)
8417 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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2479 ("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	2480 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2481 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2482 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2483
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2484 if (p <= k \|\| p >= n)
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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2487 ("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	2488 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2489 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2490
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2491
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2492 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2493 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2494 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	2495 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2496 typ != "SI")
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2497 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2498 ("eigs: unrecognized sigma value");
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 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2501 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2502 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2503 ("eigs: invalid sigma value for unsymmetric problem");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2504 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2505 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2506
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2507 if (typ == "SM")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2508 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2509 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2510 sigmar = 0.;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2511 mode = 3;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2512 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2513 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2514 else if (! std::abs (sigmar))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2515 typ = "SM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2516 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2517 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2518 typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2519 mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2520 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2521
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2522 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	2523 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2524
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2525 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2526 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2527 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2528 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2529 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	2530 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2531 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2532 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2533 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2534 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2535 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2536 // 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	2537
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2538 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	2539 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2540
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2541 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2542 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2543 octave_idx_type lwork = 3 * p * (p + 2);
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 OCTAVE_LOCAL_BUFFER (double, v, n * (p + 1));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2546 OCTAVE_LOCAL_BUFFER (double, workl, lwork + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2547 OCTAVE_LOCAL_BUFFER (double, workd, 3 * n + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2548 double *presid = resid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2549
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2550 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2551 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2552 F77_FUNC (dnaupd, DNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2553 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2554 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2555 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2556 ipntr, workd, workl, lwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2557 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	2558
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2559 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2560 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2561 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2562 ("eigs: unrecoverable exception encountered in dnaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2563 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2564 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2565
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2566 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2567 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2568 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2569 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2570 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2571 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2572 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2573 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2574 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2575 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2576
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2577 // 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	2578 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2579 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2580 // 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	2581 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2582 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2583 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2584 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2585
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2586 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2587 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2588 double *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2589 ColumnVector x(n);
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2592 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2593
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2594 ColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2595
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2596 if (err)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2597 return false;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2598
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2599 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2600 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2601 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2602 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2603 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2604 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2605 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2606 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2607 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2608 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2609 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2610 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2611 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2612 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2613 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2614 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2615
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2616 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2617
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2618 // 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	2619 // 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	2620 // 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	2621 // 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	2622 // 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	2623 // 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	2624 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2625 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	2626 octave_idx_type *sel = s.fortran_vec ();
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2627
12198 30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2628 // FIXME -- initialize eig_vec2 to zero; apparently dneupd can skip
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2629 // the assignment to elements of Z that represent imaginary parts.
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2630 // Found with valgrind and
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2631 //
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2632 // A = [1,0,0,-1;0,1,0,0;0,0,1,0;0,0,2,1];
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2633 // [vecs, vals, f] = eigs (A, 1)
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2634
30ca5a0b0e2f don't let uninitialized values escape from DNEUPD John W. Eaton <jwe@octave.org> parents: 12195 diff changeset	2635 Matrix eig_vec2 (n, k + 1, 0.0);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2636 double *z = eig_vec2.fortran_vec ();
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 OCTAVE_LOCAL_BUFFER (double, dr, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2639 OCTAVE_LOCAL_BUFFER (double, di, k + 1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2640 OCTAVE_LOCAL_BUFFER (double, workev, 3 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2641 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	2642 dr[i] = di[i] = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2643
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2644 F77_FUNC (dneupd, DNEUPD)
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2645 (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	2646 sigmai, workev, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2647 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	2648 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	2649 F77_CHAR_ARG_LEN(2));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2650
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2651 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2652 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2653 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2654 ("eigs: unrecoverable exception encountered in dneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2655 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2656 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2657 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2658 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2659 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2660 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2661
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2662 if (info2 == 0)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2663 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2664 octave_idx_type jj = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2665 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	2666 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2667 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	2668 jj++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2669 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2670 d [i-jj] = Complex (dr[i], di[i]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2671 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2672 if (jj == 0 && !rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2673 for (octave_idx_type i = 0; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2674 d[i] = d[i+1];
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 octave_idx_type k2 = k / 2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2677 for (octave_idx_type i = 0; i < k2; i++)
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 Complex dtmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2680 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2681 d[k - i - 1] = dtmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2682 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2683 eig_val.resize(k);
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 if (rvec)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2686 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2687 OCTAVE_LOCAL_BUFFER (double, dtmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2688
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2689 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2690 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2691 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2692 octave_idx_type off2 = (k - i - 1) * n;
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 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2695 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2696
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2697 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2698 dtmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2699
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2700 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2701 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2702
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2703 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2704 z[off2 + j] = dtmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2705 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2706
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2707 eig_vec.resize (n, k);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2708 octave_idx_type i = 0;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2709 while (i < k)
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 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2712 octave_idx_type off2 = (i+1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2713 if (std::imag(eig_val(i)) == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2714 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2715 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	2716 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2717 Complex(z[j+off1],0.);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2718 i++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2719 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2720 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2721 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2722 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2723 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2724 eig_vec(j,i) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2725 Complex(z[j+off1],z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2726 if (i < k - 1)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2727 eig_vec(j,i+1) =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2728 Complex(z[j+off1],-z[j+off2]);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2729 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2730 i+=2;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2731 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2732 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2733 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2734 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2735 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2736 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2737 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2738 ("eigs: error %d in dneupd", info2);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2739 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2740 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2741 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2742
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2743 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2746 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2747 octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2748 EigsComplexNonSymmetricMatrix (const M& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2749 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2750 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2751 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2752 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2753 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2754 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2755 bool cholB, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2756 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2757 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2758 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2759 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2760 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2761 bool note3 = false;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2762 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2763 Complex sigma = 0.;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2764 M bt;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2765
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2766 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2767 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2768 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2769 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2770 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2771 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	2772 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2773 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2774 ("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	2775 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2776 }
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 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2781 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2782 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2783 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2784 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2785 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	2786 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2787 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2788 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2789
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2790 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2791 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2792 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2793 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2794 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2795 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2796
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2797 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2798 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2799 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2802 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2803
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2804 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2805 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2806 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2807
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2808 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2809 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2810 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2811 ("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	2812 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2813 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2814 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2815
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	2816 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2817 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2818 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2819 ("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	2820 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2821 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2822
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2823 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2824 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2825 // Check the we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2826 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2827 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2828 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2829 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2830 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2831 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2832 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2833 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2834 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2835 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2836 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2837 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2838 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2839 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2840 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2841 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2842 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2843 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2844 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2845 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2846 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2847 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2848 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2849
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2850 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	2851 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2852 typ != "SI")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2853 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2854 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2855 ("eigs: unrecognized sigma value");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2856 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2857 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2858
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2859 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2860 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2861 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2862 ("eigs: invalid sigma value for complex problem");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2863 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2864 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2865
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2866 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2867 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2868 // See Note 3 dsaupd
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2869 note3 = true;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2870 if (cholB)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2871 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2872 bt = b;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2873 b = b.hermitian();
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2874 if (permB.length() == 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2875 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2876 permB = ColumnVector(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2877 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2878 permB(i) = i;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2879 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2880 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2881 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2882 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2883 if (! make_cholb(b, bt, permB))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2884 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2885 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2886 ("eigs: The matrix B is not positive definite");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2887 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2888 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2889 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2890 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2891
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2892 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	2893 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2894
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2895 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2896 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2897 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2898 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2899 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	2900 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2901 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2902 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2903 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2904 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2905 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2906 // 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	2907
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2908 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	2909 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2910
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2911 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2912 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2913 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	2914
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2915 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2916 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2917 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2918 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2919 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2920
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2921 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2922 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2923 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2924 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2925 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2926 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2927 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2928 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	2929
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2930 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2931 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2932 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2933 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2934 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2935 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2936
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2937 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2938 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2939 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2940 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2941 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2942 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2943 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2944 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2945 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2946 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2947
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2948 // 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	2949 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2950 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2951 // 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	2952 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2953 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2954 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2955 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2956
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2957 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2958 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2959 if (have_b)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2960 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2961 ComplexMatrix mtmp (n,1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2962 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2963 mtmp(i,0) = workd[i + iptr(0) - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2964 mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2965 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2966 workd[i+iptr(1)-1] = mtmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2967
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2968 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2969 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	2970 workd + iptr(1) - 1))
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2971 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2972 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2973 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2974 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2975 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2976 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2977 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2978 ("eigs: error %d in znaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2979 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2980 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2981 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	2982 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2983 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2984 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2985
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2986 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2987
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	2988 // 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	2989 // 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	2990 // 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	2991 // 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	2992 // 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	2993 // 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	2994 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	2995 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	2996 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	2999 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3002 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3003
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3004 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3005
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3006 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3007 (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	3008 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3009 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3010 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	3011 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	3012
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3013 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3014 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3015 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3016 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3017 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3018 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3019
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3020 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3021 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3022 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3023 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	3024 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3025 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3026 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3027 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3028 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3029 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3030
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3031 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3032 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3033 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3034
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3035 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3036 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3037 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3038 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3039
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3040 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3041 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3042
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3043 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3044 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3045
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3046 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3047 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3048
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3049 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3050 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3051 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3052
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3053 if (note3)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3054 eig_vec = ltsolve(b, permB, eig_vec);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3055 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3056 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3057 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3058 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3059 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3060 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3061 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3062 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3063
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3064 return ip(4);
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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3067 template <class M>
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3068 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3069 EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3070 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	3071 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3072 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3073 ComplexColumnVector &eig_val, const M& _b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3074 ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3075 ComplexColumnVector &cresid,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3076 std::ostream& os, double tol, bool rvec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3077 bool cholB, int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3078 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3079 M b(_b);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3080 octave_idx_type n = m.cols ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3081 octave_idx_type mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3082 bool have_b = ! b.is_empty();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3083 std::string typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3084
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3085 if (m.rows() != m.cols())
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3086 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3087 (*current_liboctave_error_handler) ("eigs: A must be square");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3088 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3089 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3090 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	3091 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3092 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3093 ("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	3094 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3095 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3096
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3097 // 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	3098 //if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3099 // 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	3100 // eig_val, _b, permB, cresid, os, tol,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3101 // rvec, cholB, disp, maxit);
8417 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 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3106 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3107 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3108 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3109 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3110 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	3111 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3112 octave_rand::distribution(rand_dist);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3113 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3114
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3115 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3116 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3117 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3118 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3119 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3120 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3121
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3122 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3123 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3124 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3127 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3128
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3129 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3130 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3131 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3132
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3133 if (k <= 0 \|\| k >= n - 1)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3134 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3135 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3136 ("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	3137 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3138 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3139 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3140
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3141 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3142 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3143 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3144 ("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	3145 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3146 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3147
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3148 if (have_b && cholB && permB.length() != 0)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3149 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3150 // Check that we really have a permutation vector
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3151 if (permB.length() != n)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3152 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3153 (*current_liboctave_error_handler) ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3154 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3155 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3156 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3157 {
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3158 Array<bool> checked (dim_vector (n, 1), false);
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3159 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3160 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3161 octave_idx_type bidx =
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3162 static_cast<octave_idx_type> (permB(i));
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3163 if (checked(bidx) \|\| bidx < 0 \|\|
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3164 bidx >= n \|\| D_NINT (bidx) != bidx)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3165 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3166 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3167 ("eigs: permB vector invalid");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3168 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3169 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3170 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3171 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3172 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3173
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3174 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3175 if (have_b)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3176 bmat = 'G';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3177
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3178 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	3179 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3180
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3181 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3182 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3183 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3184 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3185 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	3186 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3187 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3188 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3189 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3190 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3191 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3192 // ip(7) to ip(10) return values
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3193
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3194 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	3195 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3196
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3197 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3198 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3199 M L, U;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3200
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3201 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	3202 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	3203
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3204 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	3205 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3206
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3207 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	3208
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3209 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3210 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3211 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3212 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3213 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3214
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3215 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3216 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3217 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3218 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3219 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3220 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3221 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3222 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	3223
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3224 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3225 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3226 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3227 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3228 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3229 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3230
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3231 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3232 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3233 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3234 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3235 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3236 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3237 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3238 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3239 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3240 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3241
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3242 // 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	3243 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3244 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3245 // 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	3246 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3247 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3248 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3249 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3250
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3251 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3252 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3253 if (have_b)
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 if (ido == -1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3256 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3257 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3258
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3259 vector_product (m, workd+iptr(0)-1, ctmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3260
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3261 ComplexMatrix tmp(n, 1);
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 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3264 tmp(i,0) = ctmp[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3265
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3266 lusolve (L, U, tmp);
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 Complex *ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3269 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3270 ip2[Q[i]] = tmp(i,0);
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 else if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3273 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	3274 else
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 Complex *ip2 = workd+iptr(2)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3277 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3278
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3279 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3280 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3281
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3282 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3283
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3284 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3285 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3286 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3287 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3288 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3289 else
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 if (ido == 2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3292 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3293 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3294 workd[iptr(0) + i - 1] =
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3295 workd[iptr(1) + i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3296 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3297 else
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3298 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3299 Complex *ip2 = workd+iptr(0)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3300 ComplexMatrix tmp(n, 1);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3301
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3302 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3303 tmp(i,0) = ip2[P[i]];
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3304
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3305 lusolve (L, U, tmp);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3306
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3307 ip2 = workd+iptr(1)-1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3308 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3309 ip2[Q[i]] = tmp(i,0);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3310 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3311 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3312 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3313 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3314 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3315 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3316 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3317 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3318 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3319 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3320 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3321 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3322 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3323 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3324 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3325
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3326 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3327
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3328 // 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	3329 // 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	3330 // 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	3331 // 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	3332 // 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	3333 // 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	3334 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3335 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	3336 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3339 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3342 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3343
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3344 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3345
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3346 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3347 (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	3348 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3349 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3350 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	3351 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	3352
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3353 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3354 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3355 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3356 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3357 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3358 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3359
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3360 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3361 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3362 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3363 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	3364 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3365 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3366 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3367 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3368 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3369 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3370
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3371 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3372 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3373 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3374
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3375 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3376 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3377 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3378 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3379
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3380 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3381 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3382
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3383 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3384 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3385
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3386 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3387 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3388
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3389 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3390 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3391 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3392 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3393 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3394 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3395 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3396 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3397 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3398 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3399 }
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 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3402 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3403
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3404 octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3405 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3406 const std::string &_typ, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3407 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	3408 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3409 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3410 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	3411 double tol, bool rvec, bool /* cholB */,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3412 int disp, int maxit)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3413 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3414 std::string typ (_typ);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3415 bool have_sigma = (std::abs(sigma) ? true : false);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3416 char bmat = 'I';
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3417 octave_idx_type mode = 1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3418 int err = 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 if (cresid.is_empty())
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 std::string rand_dist = octave_rand::distribution();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3423 octave_rand::distribution("uniform");
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3424 Array<double> rr (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3425 Array<double> ri (octave_rand::vector(n));
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3426 cresid = ComplexColumnVector (n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3427 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	3428 cresid(i) = Complex(rr(i),ri(i));
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3429 octave_rand::distribution(rand_dist);
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
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3432 if (n < 3)
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3433 {
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3434 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3435 ("eigs: n must be at least 3");
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3436 return -1;
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3437 }
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3438
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3439 if (p < 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3440 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3441 p = k * 2 + 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 if (p < 20)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3444 p = 20;
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3445
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3446 if (p > n - 1)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3447 p = n - 1 ;
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3448 }
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3449
ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3450 if (k <= 0 \|\| k >= n - 1)
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 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3453 ("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	3454 " Use 'eig(full(A))' instead");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3455 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3456 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3457
9228 ab40ef1e232f fix tests within eigs-base.cc Jaroslav Hajek <highegg@gmail.com> parents: 8920 diff changeset	3458 if (p <= k \|\| p >= n)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3459 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3460 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3461 ("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	3462 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3463 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3464
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3465 if (! have_sigma)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3466 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3467 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	3468 typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" &&
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3469 typ != "SI")
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3470 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3471 ("eigs: unrecognized sigma value");
8417 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 if (typ == "LA" \|\| typ == "SA" \|\| typ == "BE")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3474 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3475 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3476 ("eigs: invalid sigma value for complex problem");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3477 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3478 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3479
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3480 if (typ == "SM")
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3481 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3482 typ = "LM";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3483 sigma = 0.;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3484 mode = 3;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3485 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3486 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3487 else if (! std::abs (sigma))
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3488 typ = "SM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3489 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3490 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3491 typ = "LM";
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3492 mode = 3;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3493 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3494
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3495 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	3496 octave_idx_type *iparam = ip.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3497
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3498 ip(0) = 1; //ishift
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3499 ip(1) = 0; // ip(1) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3500 ip(2) = maxit; // mxiter, maximum number of iterations
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3501 ip(3) = 1; // NB blocksize in recurrence
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3502 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	3503 ip(5) = 0; //ip(5) not referenced
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3504 ip(6) = mode; // mode
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3505 ip(7) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3506 ip(8) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3507 ip(9) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3508 ip(10) = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3509 // 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	3510
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3511 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	3512 octave_idx_type *ipntr = iptr.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3513
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3514 octave_idx_type ido = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3515 int iter = 0;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3516 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	3517
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3518 OCTAVE_LOCAL_BUFFER (Complex, v, n * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3519 OCTAVE_LOCAL_BUFFER (Complex, workl, lwork);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3520 OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3521 OCTAVE_LOCAL_BUFFER (double, rwork, p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3522 Complex *presid = cresid.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3523
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3524 do
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3525 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3526 F77_FUNC (znaupd, ZNAUPD)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3527 (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3528 F77_CONST_CHAR_ARG2 ((typ.c_str()), 2),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3529 k, tol, presid, p, v, n, iparam,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3530 ipntr, workd, workl, lwork, rwork, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3531 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	3532
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3533 if (f77_exception_encountered)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3534 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3535 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3536 ("eigs: unrecoverable exception encountered in znaupd");
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3537 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3538 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3539
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3540 if (disp > 0 && !xisnan(workl[iptr(5)-1]))
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3541 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3542 if (iter++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3543 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3544 os << "Iteration " << iter - 1 <<
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3545 ": a few Ritz values of the " << p << "-by-" <<
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3546 p << " matrix\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3547 for (int i = 0 ; i < k; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3548 os << " " << workl[iptr(5)+i-1] << "\n";
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3549 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3550
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3551 // 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	3552 // iteration pointer. But as workl[iptr(5)-1] is
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3553 // an output value updated at each iteration, setting
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3554 // 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	3555 // is a way of obtaining the iteration counter.
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3556 if (ido != 99)
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3557 workl[iptr(5)-1] = octave_NaN;
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3558 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3559
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3560 if (ido == -1 \|\| ido == 1 \|\| ido == 2)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3561 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3562 Complex *ip2 = workd + iptr(0) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3563 ComplexColumnVector x(n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3564
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3565 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3566 x(i) = *ip2++;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3567
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3568 ComplexColumnVector y = fun (x, err);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3569
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3570 if (err)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3571 return false;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3572
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3573 ip2 = workd + iptr(1) - 1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3574 for (octave_idx_type i = 0; i < n; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3575 *ip2++ = y(i);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3576 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3577 else
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3578 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3579 if (info < 0)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3580 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3581 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3582 ("eigs: error %d in dsaupd", info);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3583 return -1;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3584 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3585 break;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3586 }
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3587 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3588 while (1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3589
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3590 octave_idx_type info2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3591
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3592 // 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	3593 // 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	3594 // 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	3595 // 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	3596 // 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	3597 // 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	3598 // avoid problems.
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	3599 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	3600 octave_idx_type *sel = s.fortran_vec ();
8417 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 eig_vec.resize (n, k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3603 Complex *z = eig_vec.fortran_vec ();
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 eig_val.resize (k+1);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3606 Complex *d = eig_val.fortran_vec ();
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3607
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3608 OCTAVE_LOCAL_BUFFER (Complex, workev, 2 * p);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3609
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3610 F77_FUNC (zneupd, ZNEUPD)
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3611 (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	3612 F77_CONST_CHAR_ARG2 (&bmat, 1), n,
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3613 F77_CONST_CHAR_ARG2 ((typ.c_str ()), 2),
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3614 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	3615 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	3616
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3617 if (f77_exception_encountered)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3618 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3619 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3620 ("eigs: unrecoverable exception encountered in zneupd");
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3621 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3622 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3623
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3624 if (info2 == 0)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3625 {
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3626 octave_idx_type k2 = k / 2;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3627 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	3628 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3629 Complex ctmp = d[i];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3630 d[i] = d[k - i - 1];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3631 d[k - i - 1] = ctmp;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3632 }
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3633 eig_val.resize(k);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3634
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3635 if (rvec)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3636 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3637 OCTAVE_LOCAL_BUFFER (Complex, ctmp, n);
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3638
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3639 for (octave_idx_type i = 0; i < k2; i++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3640 {
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3641 octave_idx_type off1 = i * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3642 octave_idx_type off2 = (k - i - 1) * n;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3643
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3644 if (off1 == off2)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3645 continue;
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3646
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3647 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3648 ctmp[j] = z[off1 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3649
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3650 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3651 z[off1 + j] = z[off2 + j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3652
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3653 for (octave_idx_type j = 0; j < n; j++)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3654 z[off2 + j] = ctmp[j];
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3655 }
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3656 }
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 else
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3659 {
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3660 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3661 ("eigs: error %d in zneupd", info2);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3662 return -1;
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3663 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3664
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3665 return ip(4);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3666 }
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3667
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3668 #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3669 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3670 EigsRealSymmetricMatrix (const Matrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3671 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3672 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3673 ColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3674 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3675 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	3676 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	3677 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3678
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3679 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3680 EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3681 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3682 octave_idx_type &info, Matrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3683 ColumnVector &eig_val, const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3684 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3685 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	3686 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	3687 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3688
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3689 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3690 EigsRealSymmetricMatrixShift (const Matrix& m, 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,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3692 octave_idx_type &info, Matrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3693 ColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3694 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3695 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	3696 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	3697 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3698
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3699 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3700 EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3701 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	3702 octave_idx_type &info, Matrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3703 ColumnVector &eig_val, const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3704 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3705 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	3706 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	3707 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3708
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3709 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3710 EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3711 const std::string &typ, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3712 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3713 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3714 Matrix &eig_vec, ColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3715 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	3716 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3717 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	3718
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3719 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3720 EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3721 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3722 octave_idx_type &info, ComplexMatrix &eig_vec,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3723 ComplexColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3724 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3725 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	3726 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	3727 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3728
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3729 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3730 EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3731 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3732 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	3733 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3734 const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3735 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3736 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	3737 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	3738 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3739
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3740 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3741 EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3742 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3743 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3744 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3745 ComplexColumnVector &eig_val, const Matrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3746 ColumnVector &permB, ColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3747 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	3748 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	3749 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3750
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3751 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3752 EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3753 octave_idx_type k, octave_idx_type p,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3754 octave_idx_type &info,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3755 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3756 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3757 const SparseMatrix& b,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3758 ColumnVector &permB, ColumnVector &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,
10361 b4f67ca318d8 eigs-base.cc: fix prototypes for arpack functions John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	3760 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	3761 int disp = 0, 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
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3764 EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3765 const std::string &_typ, double sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3766 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	3767 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3768 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3769 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	3770 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3771 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	3772
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3773 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3774 EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3775 octave_idx_type k, octave_idx_type p,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3776 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	3777 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3778 const ComplexMatrix& b, ColumnVector &permB,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3779 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3780 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	3781 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	3782 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3783
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3784 extern octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3785 EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3786 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	3787 octave_idx_type p, octave_idx_type &info,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3788 ComplexMatrix &eig_vec,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3789 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3790 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3791 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3792 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3793 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	3794 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	3795 int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3796
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3797 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3798 EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3799 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	3800 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3801 ComplexMatrix &eig_vec,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3802 ComplexColumnVector &eig_val,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3803 const ComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3804 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3805 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3806 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	3807 bool rvec = false, bool cholB = 0,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3808 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3809
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3810 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3811 EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3812 Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3813 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	3814 octave_idx_type &info,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3815 ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3816 ComplexColumnVector &eig_val,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3817 const SparseComplexMatrix& b,
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3818 ColumnVector &permB,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3819 ComplexColumnVector &resid,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3820 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	3821 bool rvec = false, bool cholB = 0,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3822 int disp = 0, int maxit = 300);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3823
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3824 extern octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3825 EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3826 const std::string &_typ, Complex sigma,
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3827 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	3828 octave_idx_type &info, ComplexMatrix &eig_vec,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3829 ComplexColumnVector &eig_val,
12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3830 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	3831 double tol = DBL_EPSILON, bool rvec = false,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3832 bool cholB = 0, int disp = 0, int maxit = 300);
14144 834df9f10963 remove ARPACK files from sources and restore configure checks for external ARPACK library John W. Eaton <jwe@octave.org> parents: 14138 diff changeset	3833 #endif
8417 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 #ifndef _MSC_VER
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3836 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3837 lusolve (const SparseMatrix&, const SparseMatrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3838
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3839 template static octave_idx_type
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3840 lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3841 ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3842
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3843 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3844 lusolve (const Matrix&, const Matrix&, Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3845
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3846 template static octave_idx_type
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3847 lusolve (const ComplexMatrix&, const ComplexMatrix&, ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3848
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3849 template static ComplexMatrix
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	3850 ltsolve (const SparseComplexMatrix&, const ColumnVector&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3851 const ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3852
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3853 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3854 ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3855
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3856 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3857 ltsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3858
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3859 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3860 ltsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3861
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3862 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3863 utsolve (const SparseComplexMatrix&, const ColumnVector&,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	3864 const ComplexMatrix&);
8417 654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3865
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3866 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3867 utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3868
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3869 template static ComplexMatrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3870 utsolve (const ComplexMatrix&, const ColumnVector&, const ComplexMatrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3871
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3872 template static Matrix
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3873 utsolve (const Matrix&, const ColumnVector&, const Matrix&);
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3874 #endif
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3875
654bcfb937bf Add the eigs and svds functions David Bateman <dbateman@free.fr> parents: diff changeset	3876 #endif

Mercurial > octave-nkf

annotate liboctave/eigs-base.cc @ 15536:2e8eb9ac43a5 stable rc-3-6-4-0