Mercurial > hg > octave-max
changeset 1954:5328a7bc9b9d
[project @ 1996-02-14 20:23:31 by jwe]
author | jwe |
---|---|
date | Wed, 14 Feb 1996 20:23:31 +0000 |
parents | b7acdab21240 |
children | d6294ee6f989 |
files | src/qzval.cc |
diffstat | 1 files changed, 11 insertions(+), 128 deletions(-) [+] |
line wrap: on
line diff
--- a/src/qzval.cc +++ b/src/qzval.cc @@ -29,152 +29,35 @@ #include <cfloat> -#include "f77-fcn.h" - #include "defun-dld.h" #include "error.h" #include "gripes.h" #include "help.h" #include "oct-obj.h" -#include "user-prefs.h" -#include "utils.h" -extern "C" -{ - int F77_FCN (qzhes, QZHES) (const int&, const int&, double*, - double*, const long&, double*); - - int F77_FCN (qzit, QZIT) (const int&, const int&, double*, double*, - const double&, const long&, double*, - int&); - - int F77_FCN (qzval, QZVAL) (const int&, const int&, double*, - double*, double*, double*, double*, - const long&, double*); -} - -DEFUN_DLD_BUILTIN ("qzval", Fqzval, Sqzval, FSqzval, 11, +DEFUN_DLD_BUILTIN ("qzval", Fqzval, Sqzval, FSqzval, 10, "X = qzval (A, B)\n\ \n\ compute generalized eigenvalues of the matrix pencil (A - lambda B).\n\ A and B must be real matrices.") { - Octave_object retval; + tree_constant retval; int nargin = args.length (); - if (nargin != 2 || nargout > 1) - { - print_usage ("qzval"); - return retval; - } - - tree_constant arg_a = args(0); - tree_constant arg_b = args(1); - - int a_nr = arg_a.rows(); - int a_nc = arg_a.columns(); - - int b_nr = arg_b.rows(); - int b_nc = arg_b.columns(); - - int arg_a_is_empty = empty_arg ("qzval", a_nr, a_nc); - int arg_b_is_empty = empty_arg ("qzval", b_nr, b_nc); - - if (arg_a_is_empty > 0 && arg_b_is_empty > 0) - return Matrix (); - else if (arg_a_is_empty || arg_b_is_empty) - return retval; - - // Arguments are not empty, so check for correct dimensions. - - if (a_nr != a_nc || b_nr != b_nc) + if (nargin == 2) { - gripe_square_matrix_required ("qzval: first two parameters:"); - return retval; - } - - if (a_nr != b_nr) - { - gripe_nonconformant (); - return retval; - } - - // Dimensions look o.k., let's solve the problem. - - if (arg_a.is_complex_type () || arg_b.is_complex_type ()) - { - error ("qzval: cannot yet do complex matrix arguments\n"); - return retval; - } - - // Do everything in real arithmetic. - - Matrix jnk (a_nr, a_nr, 0.0); - - ColumnVector alfr (a_nr); - ColumnVector alfi (a_nr); - ColumnVector beta (a_nr); - - long matz = 0; - int info; + tree_constant arg_a = args(0); + tree_constant arg_b = args(1); - // XXX FIXME ??? XXX - double eps = DBL_EPSILON; - - Matrix ca = arg_a.matrix_value (); - - if (error_state) - return retval; - - Matrix cb = arg_b.matrix_value (); - - if (error_state) - return retval; - - // Use EISPACK qz functions. - - F77_FCN (qzhes, QZHES) (a_nr, a_nr, ca.fortran_vec (), - cb.fortran_vec (), matz, - jnk.fortran_vec ()); - - F77_FCN (qzit, QZIT) (a_nr, a_nr, ca.fortran_vec (), - cb.fortran_vec (), eps, matz, - jnk.fortran_vec (), info); - - if (info) - error ("qzval: trouble in qzit, info = %d", info); + Matrix a = arg_a.matrix_value (); + Matrix b = arg_b.matrix_value (); - F77_FCN (qzval, QZVAL) (a_nr, a_nr, ca.fortran_vec (), - cb.fortran_vec (), alfr.fortran_vec (), - alfi.fortran_vec (), beta.fortran_vec (), - matz, jnk.fortran_vec ()); - - // Count and extract finite generalized eigenvalues. - - int i; - int cnt = 0; - - Complex Im (0, 1); - - for (i = 0; i < a_nr; i++) - if (beta (i) != 0) - cnt++; - - ComplexColumnVector cx (cnt, 0.0); - - for (i = 0; i < a_nr; i++) - { - if (beta (i) != 0) - { - // Finite generalized eigenvalue. - - cnt--; - cx (cnt) = (alfr (i) + Im * alfi (i)) / beta (i); - } + if (! error_state) + retval = Qzval (a, b); } - - retval = cx; + else + print_usage ("qzval"); return retval; }