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

annotate liboctave/numeric/eigs-base.cc @ 21202:f7121e111991

maint: indent #ifdef blocks in liboctave and src directories. * Array-C.cc, Array-b.cc, Array-ch.cc, Array-d.cc, Array-f.cc, Array-fC.cc, Array-i.cc, Array-idx-vec.cc, Array-s.cc, Array-str.cc, Array-util.cc, Array-voidp.cc, Array.cc, CColVector.cc, CDiagMatrix.cc, CMatrix.cc, CNDArray.cc, CRowVector.cc, CSparse.cc, CSparse.h, DiagArray2.cc, MArray-C.cc, MArray-d.cc, MArray-f.cc, MArray-fC.cc, MArray-i.cc, MArray-s.cc, MArray.cc, MDiagArray2.cc, MSparse-C.cc, MSparse-d.cc, MSparse.h, MatrixType.cc, PermMatrix.cc, Range.cc, Sparse-C.cc, Sparse-b.cc, Sparse-d.cc, Sparse.cc, boolMatrix.cc, boolNDArray.cc, boolSparse.cc, chMatrix.cc, chNDArray.cc, dColVector.cc, dDiagMatrix.cc, dMatrix.cc, dNDArray.cc, dRowVector.cc, dSparse.cc, dSparse.h, dim-vector.cc, fCColVector.cc, fCDiagMatrix.cc, fCMatrix.cc, fCNDArray.cc, fCRowVector.cc, fColVector.cc, fDiagMatrix.cc, fMatrix.cc, fNDArray.cc, fRowVector.cc, idx-vector.cc, int16NDArray.cc, int32NDArray.cc, int64NDArray.cc, int8NDArray.cc, intNDArray.cc, uint16NDArray.cc, uint32NDArray.cc, uint64NDArray.cc, uint8NDArray.cc, blaswrap.c, cquit.c, f77-extern.cc, f77-fcn.c, f77-fcn.h, lo-error.c, quit.cc, quit.h, CmplxAEPBAL.cc, CmplxCHOL.cc, CmplxGEPBAL.cc, CmplxHESS.cc, CmplxLU.cc, CmplxQR.cc, CmplxQRP.cc, CmplxSCHUR.cc, CmplxSVD.cc, CollocWt.cc, DASPK.cc, DASRT.cc, DASSL.cc, EIG.cc, LSODE.cc, ODES.cc, Quad.cc, base-lu.cc, base-qr.cc, dbleAEPBAL.cc, dbleCHOL.cc, dbleGEPBAL.cc, dbleHESS.cc, dbleLU.cc, dbleQR.cc, dbleQRP.cc, dbleSCHUR.cc, dbleSVD.cc, eigs-base.cc, fCmplxAEPBAL.cc, fCmplxCHOL.cc, fCmplxGEPBAL.cc, fCmplxHESS.cc, fCmplxLU.cc, fCmplxQR.cc, fCmplxQRP.cc, fCmplxSCHUR.cc, fCmplxSVD.cc, fEIG.cc, floatAEPBAL.cc, floatCHOL.cc, floatGEPBAL.cc, floatHESS.cc, floatLU.cc, floatQR.cc, floatQRP.cc, floatSCHUR.cc, floatSVD.cc, lo-mappers.cc, lo-specfun.cc, oct-convn.cc, oct-fftw.cc, oct-fftw.h, oct-norm.cc, oct-rand.cc, oct-spparms.cc, randgamma.c, randmtzig.c, randpoisson.c, sparse-chol.cc, sparse-dmsolve.cc, sparse-lu.cc, sparse-qr.cc, mx-defs.h, dir-ops.cc, file-ops.cc, file-stat.cc, lo-sysdep.cc, mach-info.cc, oct-env.cc, oct-group.cc, oct-openmp.h, oct-passwd.cc, oct-syscalls.cc, oct-time.cc, oct-uname.cc, pathlen.h, sysdir.h, syswait.h, cmd-edit.cc, cmd-hist.cc, data-conv.cc, f2c-main.c, glob-match.cc, lo-array-errwarn.cc, lo-array-gripes.cc, lo-cutils.c, lo-cutils.h, lo-ieee.cc, lo-math.h, lo-regexp.cc, lo-utils.cc, oct-base64.cc, oct-glob.cc, oct-inttypes.cc, oct-inttypes.h, oct-locbuf.cc, oct-mutex.cc, oct-refcount.h, oct-rl-edit.c, oct-rl-hist.c, oct-shlib.cc, oct-sort.cc, pathsearch.cc, singleton-cleanup.cc, sparse-sort.cc, sparse-util.cc, statdefs.h, str-vec.cc, unwind-prot.cc, url-transfer.cc, display-available.h, main-cli.cc, main-gui.cc, main.in.cc, mkoctfile.in.cc, octave-config.in.cc, shared-fcns.h: indent #ifdef blocks in liboctave and src directories.

author	Rik <rik@octave.org>
date	Sat, 06 Feb 2016 06:40:13 -0800
parents	342764537e5a
children	3c8a3d35661a

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

Mercurial > octave

annotate liboctave/numeric/eigs-base.cc @ 21202:f7121e111991