Mercurial > hg > octave-nkf

changeset 1929:908f5b6676d7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1996-02-11 22:05:08 by jwe]
author jwe
date Sun, 11 Feb 1996 22:05:23 +0000
parents 20353fa5f83d
children d20ab06301e8
files liboctave/CmplxSCHUR.cc liboctave/CmplxSCHUR.h liboctave/dbleSCHUR.cc liboctave/dbleSCHUR.h liboctave/dir-ops.cc liboctave/dir-ops.h
diffstat 6 files changed, 117 insertions(+), 114 deletions(-) [+]
line wrap: on
line diff
--- a/liboctave/CmplxSCHUR.cc
+++ b/liboctave/CmplxSCHUR.cc
@@ -37,7 +37,7 @@
 extern "C"
 {
   int F77_FCN (zgeesx, ZGEESX) (const char*, const char*,
-				int (*)(const Complex&), 
+				ComplexSCHUR::select_function,
 				const char*, const int&, Complex*,
 				const int&, int&, Complex*, Complex*,
 				const int&, double&, double&,
@@ -46,13 +46,13 @@
 }
 
 static int
-complex_select_ana (const Complex& a)
+select_ana (const Complex& a)
 {
   return a.real () < 0.0;
 }
 
 static int
-complex_select_dig (const Complex& a)
+select_dig (const Complex& a)
 {
   return (abs (a) < 1.0);
 }
@@ -62,6 +62,7 @@
 {
   int a_nr = a.rows ();
   int a_nc = a.cols ();
+
   if (a_nr != a_nc)
     {
       (*current_liboctave_error_handler)
@@ -70,16 +71,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";
+    sort = "S";
 
-  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;
@@ -88,49 +92,36 @@
   double rconde;
   double rcondv;
 
-  double *rwork = new double [n];
+  schur_mat = a;
+  unitary_mat.resize (n, n);
+
+  Complex *s = schur_mat.fortran_vec ();
+  Complex *q = unitary_mat.fortran_vec ();
+
+  Array<double> rwork (n);
+  double *prwork = rwork.fortran_vec ();
+
+  Array<Complex> w (n);
+  Complex *pw = w.fortran_vec ();
+
+  Array<Complex> work (lwork);
+  Complex *pwork = work.fortran_vec ();
 
   // bwork is not referenced for non-ordered Schur.
 
-  int *bwork = 0;
-  if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd')
-    bwork = new int [n];
+  Array<int> bwork;
 
-  Complex *s = dup (a.data (), a.length ());
+  if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd')
+    bwork.resize (n);
 
-  Complex *work = new Complex [lwork];
-  Complex *q = new Complex [n*n];
-  Complex *w = new Complex [n];
+  int *pbwork = bwork.fortran_vec ();
 
-  if (ord_char == 'A' || ord_char == 'a')
-    {
-      F77_FCN (zgeesx, ZGEESX) (jobvs, sort, complex_select_ana,
-				sense, n, s, n, sdim, w, q, n, rconde,
-				rcondv, work, lwork, rwork, bwork,
-				info, 1L, 1L);
-    }
-  else if (ord_char == 'D' || ord_char == 'd')
-    {
-      F77_FCN (zgeesx, ZGEESX) (jobvs, sort, complex_select_dig,
-				sense, n, s, n, sdim, w, q, n, rconde,
-				rcondv, work, lwork, rwork, bwork,
-				info, 1L, 1L);
-    }
-  else
-    {
-      F77_FCN (zgeesx, ZGEESX) (jobvs, sort, (void *) 0, sense, n, s,
-				n, sdim, w, q, n, rconde, rcondv,
-				work, lwork, rwork, bwork, info, 1L,
-				1L);
-    }
+  F77_XFCN (zgeesx, ZGEESX, (jobvs, sort, selector, sense, n, s, n,
+			     sdim, pw, q, n, rconde, rcondv, pwork,
+			     lwork, prwork, pbwork, info, 1L, 1L));
 
-  schur_mat = ComplexMatrix (s, n, n);
-  unitary_mat = ComplexMatrix (q, n, n);
-
-  delete [] w;
-  delete [] work;
-  delete [] rwork;
-  delete [] bwork;
+  if (f77_exception_encountered)
+    (*current_liboctave_error_handler) ("unrecoverable error in zgeesx");
 
   return info;
 }
--- a/liboctave/CmplxSCHUR.h
+++ b/liboctave/CmplxSCHUR.h
@@ -39,17 +39,20 @@
 {
 public:
 
-  ComplexSCHUR (void) : schur_mat (), unitary_mat () { }
+  ComplexSCHUR (void)
+    : schur_mat (), unitary_mat () { }
 
   ComplexSCHUR (const ComplexMatrix& a, const string& ord)
-    {
-      init (a,ord);
-    }
+    : schur_mat (), unitary_mat ()
+      {
+        init (a, ord);
+      }
 
   ComplexSCHUR (const ComplexMatrix& a, const string& ord, int& info)
-    {
-      info = init (a,ord);
-    }
+    : schur_mat (), unitary_mat ()
+      {
+        info = init (a,ord);
+      }
 
   ComplexSCHUR (const ComplexSCHUR& a)
     : schur_mat (a.schur_mat), unitary_mat (a.unitary_mat) { }
@@ -64,12 +67,16 @@
       return *this;
     }
 
+  ~ComplexSCHUR (void) { }
+
   ComplexMatrix schur_matrix (void) const { return schur_mat; }
 
   ComplexMatrix unitary_matrix (void) const { return unitary_mat; }
 
   friend ostream& operator << (ostream& os, const ComplexSCHUR& a);
 
+  typedef int (*select_function) (const Complex&);
+
 private:
 
   ComplexMatrix schur_mat;
--- a/liboctave/dbleSCHUR.cc
+++ b/liboctave/dbleSCHUR.cc
@@ -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;
 }
--- a/liboctave/dbleSCHUR.h
+++ b/liboctave/dbleSCHUR.h
@@ -39,14 +39,20 @@
 {
 public:
 
-  SCHUR (void) : schur_mat (), unitary_mat () { }
+  SCHUR (void)
+    : schur_mat (), unitary_mat () { }
 
-  SCHUR (const Matrix& a, const string& ord) { init (a, ord); }
+  SCHUR (const Matrix& a, const string& ord)
+    : schur_mat (), unitary_mat ()
+      {
+        init (a, ord);
+      }
 
   SCHUR (const Matrix& a, const string& ord, int& info)
-    {
-      info = init (a, ord);
-    }
+    : schur_mat (), unitary_mat ()
+      {
+        info = init (a, ord);
+      }
 
   SCHUR (const SCHUR& a)
     : schur_mat (a.schur_mat), unitary_mat (a.unitary_mat) { }
@@ -61,12 +67,16 @@
       return *this;
     }
 
+  ~SCHUR (void) { }
+
   Matrix schur_matrix (void) const { return schur_mat; }
 
   Matrix unitary_matrix (void) const { return unitary_mat; }
 
   friend ostream& operator << (ostream& os, const SCHUR& a);
 
+  typedef int (*select_function) (const double&, const double&);
+
 private:
 
   Matrix schur_mat;
--- a/liboctave/dir-ops.cc
+++ b/liboctave/dir-ops.cc
@@ -45,7 +45,7 @@
     {
       close ();
 
-      dir = opendir (name.c_str ());
+      dir = (void *) opendir (name.c_str ());
 
       if (dir)
 	fail = false;
@@ -69,16 +69,16 @@
 
       struct dirent *dir_ent;
 
-      while ((dir_ent = readdir (dir)))
+      while ((dir_ent = readdir ((DIR *) dir)))
 	count++;
 
-      rewinddir (dir);
+      rewinddir ((DIR *) dir);
 
       dirlist.resize (count);
 
       for (int i = 0; i < count; i++)
 	{
-	  dir_ent = readdir (dir);
+	  dir_ent = readdir ((DIR *) dir);
 
 	  if (dir_ent)
 	    dirlist[i] = dir_ent->d_name;
@@ -94,7 +94,7 @@
 dir_entry::close (void)
 {
   if (dir)
-    closedir (dir);
+    closedir ((DIR *) dir);
 
   dir = 0;
 }
--- a/liboctave/dir-ops.h
+++ b/liboctave/dir-ops.h
@@ -28,8 +28,6 @@
 
 #include "str-vec.h"
 
-struct DIR;
-
 class
 dir_entry
 {
@@ -45,7 +43,9 @@
 
   dir_entry& operator = (const dir_entry& d)
     {
-      copy (d);
+      if (this != &d)
+	copy (d);
+
       return *this;
     }
 
@@ -68,8 +68,10 @@
   // Name of the directory.
   string name;
 
-  // A pointer to the contents of the directory.
-  DIR *dir;
+  // A pointer to the contents of the directory.  We use void here to
+  // avoid possible conflicts with the way some systems declare the
+  // type DIR.
+  void *dir;
 
   // TRUE means the open for this directory failed.
   bool fail;