octave-nkf: liboctave/numeric/CmplxHESS.cc annotate

annotate liboctave/numeric/CmplxHESS.cc @ 20354:227d582fa300 stable

build: Sort generated PKG_ADD contents consistently * libinterp/mk-pkg-add: Set LC_COLLATE=C when sorting for consistent output.

author	Mike Miller <mtmiller@octave.org>
date	Fri, 10 Jul 2015 01:10:30 -0400
parents	4197fc428c7d
children

rev	line source
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	1 /*
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	2
19731 4197fc428c7d maint: Update copyright notices for 2015. John W. Eaton <jwe@octave.org> parents: 17744 diff changeset	3 Copyright (C) 1994-2015 John W. Eaton
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	4
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	5 This file is part of Octave.
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	6
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	7 Octave is free software; you can redistribute it and/or modify it
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	8 under the terms of the GNU General Public License as published by the
7016 93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe] jwe parents: 5307 diff changeset	9 Free Software Foundation; either version 3 of the License, or (at your
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe] jwe parents: 5307 diff changeset	10 option) any later version.
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	11
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	12 Octave is distributed in the hope that it will be useful, but WITHOUT
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	15 for more details.
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	16
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	17 You should have received a copy of the GNU General Public License
7016 93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe] jwe parents: 5307 diff changeset	18 along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe] jwe parents: 5307 diff changeset	19 <http://www.gnu.org/licenses/>.
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	20
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	21 */
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	22
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	23 #ifdef HAVE_CONFIG_H
1192 b6360f2d4fa6 [project @ 1995-03-30 21:38:35 by jwe] jwe parents: 1011 diff changeset	24 #include <config.h>
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	25 #endif
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	26
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	27 #include "CmplxHESS.h"
1847 2ffe49eb95a5 [project @ 1996-02-03 12:47:55 by jwe] jwe parents: 1368 diff changeset	28 #include "f77-fcn.h"
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	29 #include "lo-error.h"
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	30
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	31 extern "C"
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	32 {
4552 6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	33 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	34 F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL,
11495 8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	35 const octave_idx_type&, Complex*,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	36 const octave_idx_type&, octave_idx_type&,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	37 octave_idx_type&, double*, octave_idx_type&
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	38 F77_CHAR_ARG_LEN_DECL);
11586 12df7854fa7c strip trailing whitespace from source files John W. Eaton <jwe@octave.org> parents: 11570 diff changeset	39
4552 6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	40 F77_RET_T
11495 8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	41 F77_FUNC (zgehrd, ZGEHRD) (const octave_idx_type&, const octave_idx_type&,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	42 const octave_idx_type&, Complex*,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	43 const octave_idx_type&, Complex, Complex,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	44 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	45
4552 6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	46 F77_RET_T
11495 8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	47 F77_FUNC (zunghr, ZUNGHR) (const octave_idx_type&, const octave_idx_type&,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	48 const octave_idx_type&, Complex*,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	49 const octave_idx_type&, Complex, Complex,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	50 const octave_idx_type&, octave_idx_type&);
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	51
4552 6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	52 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	53 F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	54 F77_CONST_CHAR_ARG_DECL,
11495 8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	55 const octave_idx_type&, const octave_idx_type&,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	56 const octave_idx_type&, double*,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	57 const octave_idx_type&, Complex*,
8a5e980da6aa style fixes John W. Eaton <jwe@octave.org> parents: 10350 diff changeset	58 const octave_idx_type&, octave_idx_type&
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	59 F77_CHAR_ARG_LEN_DECL
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	60 F77_CHAR_ARG_LEN_DECL);
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	61 }
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	62
5275 23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	63 octave_idx_type
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	64 ComplexHESS::init (const ComplexMatrix& a)
3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	65 {
5275 23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	66 octave_idx_type a_nr = a.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	67 octave_idx_type a_nc = a.cols ();
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	68
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	69 if (a_nr != a_nc)
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	70 {
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	71 (*current_liboctave_error_handler)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	72 ("ComplexHESS requires square matrix");
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	73 return -1;
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	74 }
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	75
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	76 char job = 'N';
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	77 char side = 'R';
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	78
5275 23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	79 octave_idx_type n = a_nc;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	80 octave_idx_type lwork = 32 * n;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	81 octave_idx_type info;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	82 octave_idx_type ilo;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe] jwe parents: 5105 diff changeset	83 octave_idx_type ihi;
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	84
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	85 hess_mat = a;
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	86 Complex *h = hess_mat.fortran_vec ();
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	87
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	88 Array<double> scale (dim_vector (n, 1));
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	89 double *pscale = scale.fortran_vec ();
682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	90
4552 6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe] jwe parents: 4192 diff changeset	91 F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1),
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	92 n, h, n, ilo, ihi, pscale, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	93 F77_CHAR_ARG_LEN (1)));
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	94
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	95 Array<Complex> tau (dim_vector (n-1, 1));
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	96 Complex *ptau = tau.fortran_vec ();
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	97
11570 57632dea2446 attempt better backward compatibility for Array constructors John W. Eaton <jwe@octave.org> parents: 11523 diff changeset	98 Array<Complex> work (dim_vector (lwork, 1));
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	99 Complex *pwork = work.fortran_vec ();
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	100
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	101 F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, info));
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	102
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	103 unitary_hess_mat = hess_mat;
29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	104 Complex *z = unitary_hess_mat.fortran_vec ();
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	105
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	106 F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork,
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	107 lwork, info));
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	108
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	109 F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1),
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	110 F77_CONST_CHAR_ARG2 (&side, 1),
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	111 n, ilo, ihi, pscale, n, z, n, info
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	112 F77_CHAR_ARG_LEN (1)
07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	113 F77_CHAR_ARG_LEN (1)));
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	114
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	115 // If someone thinks of a more graceful way of
29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	116 // doing this (or faster for that matter :-)),
29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	117 // please let me know!
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	118
7482 29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	119 if (n > 2)
29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	120 for (octave_idx_type j = 0; j < a_nc; j++)
29980c6b8604 don't check f77_exception_encountered John W. Eaton <jwe@octave.org> parents: 7017 diff changeset	121 for (octave_idx_type i = j+2; i < a_nr; i++)
10314 07ebe522dac2 untabify liboctave C++ sources John W. Eaton <jwe@octave.org> parents: 10158 diff changeset	122 hess_mat.elem (i, j) = 0;
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	123
1932 682f31b20894 [project @ 1996-02-12 02:26:07 by jwe] jwe parents: 1882 diff changeset	124 return info;
457 3d4b4f0fa5ba [project @ 1994-06-06 00:33:33 by jwe] jwe parents: diff changeset	125 }

Mercurial > octave-nkf

annotate liboctave/numeric/CmplxHESS.cc @ 20354:227d582fa300 stable