diff src/qzval.cc @ 636:fae2bd91c027

[project @ 1994-08-23 18:39:50 by jwe]
author jwe
date Tue, 23 Aug 1994 18:39:50 +0000
parents aecbe369233b
children 0a81458ef677
line wrap: on
line diff
--- a/src/qzval.cc	Tue Aug 23 17:57:20 1994 +0000
+++ b/src/qzval.cc	Tue Aug 23 18:39:50 1994 +0000
@@ -38,6 +38,7 @@
 #include "user-prefs.h"
 #include "gripes.h"
 #include "error.h"
+#include "utils.h"
 #include "help.h"
 #include "defun-dld.h"
 
@@ -61,107 +62,115 @@
 {
   Octave_object retval;
 
-  int nargin = args.length ();
-
-  if (nargin != 3 || nargout > 1)
+  if (args.length () != 3 || nargout > 1)
     {
       print_usage ("qzvalue");
       return retval;
     }
 
-  tree_constant arga = args(1).make_numeric ();
-  tree_constant argb = args(2).make_numeric();
+  tree_constant arg_a = args(1);
+  tree_constant arg_b = args(2);
+
+  int a_nr = arg_a.rows();
+  int a_nc = arg_a.columns();
 
-  if (arga.is_empty () || argb.is_empty ())
-    retval = vector_of_empties (nargout, "qzvalue");
-  else
-    {
+  int b_nr = arg_b.rows();
+  int b_nc = arg_b.columns();
+  
+  if (empty_arg ("qzvalue", a_nr, a_nc) < 0
+      || empty_arg ("qzvalue", b_nr, b_nc) < 0)
+    return retval;
 
 // Arguments are not empty, so check for correct dimensions.
 
-      int a_rows = arga.rows();
-      int a_cols = arga.columns();
-      int b_rows = argb.rows();
-      int b_cols = argb.columns();
-  
-      if ((a_rows != a_cols) || (b_rows != b_cols))
-	{
-	  gripe_square_matrix_required ("qzvalue: first two parameters:");
-	  return retval;
-	}
-      else if (a_rows != b_rows)
-	{
-	  gripe_nonconformant ();
-	  return retval;
-	}
+  if (a_nr != a_nc || b_nr != b_nc)
+    {
+      gripe_square_matrix_required ("qzvalue: first two parameters:");
+      return retval;
+    }
+
+  if (a_nr != b_nr)
+    {
+      gripe_nonconformant ();
+      return retval;
+    }
   
 // Dimensions look o.k., let's solve the problem.
 
-      retval.resize (nargout ? nargout : 1);
-
-      if (arga.is_complex_type () || argb.is_complex_type ())
-	error ("qzvalue: cannot yet do complex matrix arguments\n");
-      else
-	{
+  if (arg_a.is_complex_type () || arg_b.is_complex_type ())
+    {
+      error ("qzvalue: cannot yet do complex matrix arguments\n");
+      return retval;
+    }
 
 // Do everything in real arithmetic.
 
-	  Matrix jnk (a_rows, a_rows, 0.0);
+  Matrix jnk (a_nr, a_nr, 0.0);
 
-	  ColumnVector alfr (a_rows);
-	  ColumnVector alfi (a_rows);
-	  ColumnVector beta (a_rows);
+  ColumnVector alfr (a_nr);
+  ColumnVector alfi (a_nr);
+  ColumnVector beta (a_nr);
 
-	  long matz = 0;
-	  int info;
+  long matz = 0;
+  int info;
 
 // XXX FIXME ??? XXX
-	  double eps = DBL_EPSILON;
+  double eps = DBL_EPSILON;
+
+  Matrix ca = arg_a.matrix_value ();
 
-	  Matrix ca = arga.matrix_value ();
-	  Matrix cb = argb.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) (&a_rows, &a_rows, ca.fortran_vec (),
-			   cb.fortran_vec (), &matz, jnk.fortran_vec ());
+  F77_FCN (qzhes) (&a_nr, &a_nr, ca.fortran_vec (),
+		   cb.fortran_vec (), &matz, jnk.fortran_vec ());
 
-	  F77_FCN (qzit) (&a_rows, &a_rows, ca.fortran_vec (),
-			  cb.fortran_vec (), &eps, &matz,
-			  jnk.fortran_vec (), &info);  
+  F77_FCN (qzit) (&a_nr, &a_nr, ca.fortran_vec (),
+		  cb.fortran_vec (), &eps, &matz,
+		  jnk.fortran_vec (), &info);  
 
-	  if (info)
-	    error ("qzvalue: trouble in qzit, info = %d", info);
+  if (info)
+    error ("qzvalue: trouble in qzit, info = %d", info);
 
-	  F77_FCN (qzval) (&a_rows, &a_rows, ca.fortran_vec (),
-			   cb.fortran_vec (), alfr.fortran_vec (),
-			   alfi.fortran_vec (), beta.fortran_vec (),
-			   &matz, jnk.fortran_vec ());
+  F77_FCN (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, cnt;
-	  Complex Im (0, 1);
-	  for (i = 0, cnt = 0; i < a_rows; i++)
-	    if (beta (i) != 0)
-	      cnt++;
+  int i;
+  int cnt = 0;
+
+  Complex Im (0, 1);
 
-	  ComplexColumnVector cx (cnt, 0.0);
+  for (i = 0; i < a_nr; i++)
+    if (beta (i) != 0)
+      cnt++;
 
-	  for (i = 0; i < a_rows; i++)
-	    {
-	      if (beta (i) != 0)
-		{
+  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);
-		}
-	    }
-	  retval(0) = cx;
+	  cnt--;
+	  cx (cnt) = (alfr (i) + Im * alfi (i)) / beta (i);
 	}
     }
+
+  retval = cx;
+
   return retval;
 }