diff liboctave/dbleSCHUR.cc @ 1929:908f5b6676d7

[project @ 1996-02-11 22:05:08 by jwe]
author jwe
date Sun, 11 Feb 1996 22:05:23 +0000
parents 1281a23a34dd
children d20ab06301e8
line wrap: on
line diff
--- a/liboctave/dbleSCHUR.cc	Sun Feb 11 21:51:54 1996 +0000
+++ b/liboctave/dbleSCHUR.cc	Sun Feb 11 22:05:23 1996 +0000
@@ -39,12 +39,12 @@
 extern "C"
 {
   int F77_FCN (dgeesx, DGEESX) (const char*, const char*,
-				int (*)(const double&, const double&),
-				const char*, const int&, double*,
-				const int&, int&, double*, double*,
-				double*, const int&, double&, double&,
-				double*, const int&, int*, const int&,
-				int*, int&, long, long);
+				SCHUR::select_function, const char*,
+				const int&, double*, const int&,
+				int&, double*, double*, double*,
+				const int&, double&, double&, double*,
+				const int&, int*, const int&, int*,
+				int&, long, long);
 }
 
 static int
@@ -64,6 +64,7 @@
 {
   int a_nr = a.rows ();
   int a_nc = a.cols ();
+
   if (a_nr != a_nc)
     {
       (*current_liboctave_error_handler) ("SCHUR requires square matrix");
@@ -71,16 +72,19 @@
     }
 
   char *jobvs = "V";
-  char *sort;
+  char *sense = "N";
+  char *sort = "N";
 
   char ord_char = ord.empty () ? 'U' : ord[0];
 
   if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd')
     sort = "S";
-  else
-    sort = "N";
 
-  char *sense = "N";
+  select_function selector = 0;
+  if (ord_char == 'A' || ord_char == 'a')
+    selector = select_ana;
+  else if (ord_char == 'D' || ord_char == 'd')
+    selector = select_dig;
 
   int n = a_nc;
   int lwork = 8 * n;
@@ -90,54 +94,43 @@
   double rconde;
   double rcondv;
 
-  double *s = dup (a.data (), a.length ());
+  schur_mat = a;
+  unitary_mat.resize (n, n);
+
+  double *s = schur_mat.fortran_vec ();
+  double *q = unitary_mat.fortran_vec ();
 
-  double *wr = new double [n];
-  double *wi = new double [n];
-  double *q = new double [n*n];
-  double *work = new double [lwork];
+  Array<double> wr (n);
+  double *pwr = wr.fortran_vec ();
+
+  Array<double> wi (n);
+  double *pwi = wi.fortran_vec ();
+
+  Array<double> work (lwork);
+  double *pwork = work.fortran_vec ();
 
   // These are not referenced for the non-ordered Schur routine.
 
-  int *iwork = 0;
-  int *bwork = 0;
+  Array<int> bwork;
+  Array<int> iwork;
+
   if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd')
     {
-      iwork = new int [liwork];
-      bwork = new int [n];
+      bwork.resize (n);
+      iwork.resize (liwork);
     }
 
-  if (ord_char == 'A' || ord_char == 'a')
-    {
-      F77_FCN (dgeesx, DGEESX) (jobvs, sort, select_ana, sense, n, s,
-				n, sdim, wr, wi, q, n, rconde, rcondv,
-				work, lwork, iwork, liwork, bwork,
-				info, 1L, 1L);
-    }
-  else if (ord_char == 'D' || ord_char == 'd')
-    {
-      F77_FCN (dgeesx, DGEESX) (jobvs, sort, select_dig, sense, n, s,
-				n, sdim, wr, wi, q, n, rconde, rcondv,
-				work, lwork, iwork, liwork, bwork,
-				info, 1L, 1L);
-      
-    }
-  else
-    {
-      F77_FCN (dgeesx, DGEESX) (jobvs, sort, (void *) 0, sense, n, s,
-				n, sdim, wr, wi, q, n, rconde, rcondv,
-				work, lwork, iwork, liwork, bwork,
-				info, 1L, 1L);
-    }
+  int *pbwork = bwork.fortran_vec ();
+  int *piwork = iwork.fortran_vec ();
+
 
-  schur_mat = Matrix (s, n, n);
-  unitary_mat = Matrix (q, n, n);
+  F77_XFCN (dgeesx, DGEESX, (jobvs, sort, selector, sense, n, s,
+			     n, sdim, pwr, pwi, q, n, rconde, rcondv,
+			     pwork, lwork, piwork, liwork, pbwork,
+			     info, 1L, 1L));
 
-  delete [] wr;
-  delete [] wi;
-  delete [] work;
-  delete [] iwork;
-  delete [] bwork;
+  if (f77_exception_encountered)
+    (*current_liboctave_error_handler) ("unrecoverable error in dgeesx");
 
   return info;
 }