Mercurial > octave

changeset 233:0e77ff277fdc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1993-11-16 10:52:17 by jwe]
author jwe
date Tue, 16 Nov 1993 10:52:17 +0000
parents e1b072bcffb9
children a366eb563bf2
files liboctave/Matrix-ext.cc
diffstat 1 files changed, 132 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/liboctave/Matrix-ext.cc	Tue Nov 16 10:44:56 1993 +0000
+++ b/liboctave/Matrix-ext.cc	Tue Nov 16 10:52:17 1993 +0000
@@ -28,6 +28,129 @@
 #include "Matrix.h"
 #include "mx-inlines.cc"
 #include "lo-error.h"
+#include "f77-uscore.h"
+
+// Fortran functions we call.
+
+extern "C"
+{
+  int F77_FCN (dgesv) (const int*, const int*, double*, const int*,
+		       int*, double*, const int*, int*);
+
+  int F77_FCN (dgeqrf) (const int*, const int*, double*, const int*,
+			double*, double*, const int*, int*);
+
+  int F77_FCN (dorgqr) (const int*, const int*, const int*, double*,
+			const int*, double*, double*, const int*, int*);
+
+  int F77_FCN (dgeev) (const char*, const char*, const int*, double*,
+		       const int*, double*, double*, double*,
+		       const int*, double*, const int*, double*,
+		       const int*, int*, long, long);
+
+  int F77_FCN (dgeesx) (const char*, const char*, int (*)(), 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);
+
+  int F77_FCN (dgebal) (const char*, const int*, double*,
+                        const int*, int*, int*, double*,
+                        int*, long, long);
+
+  int F77_FCN (dgebak) (const char*, const char*, const int*, const int*,
+			const int*, double*, const int*, double*, const int*,
+			int*, long, long);
+
+  int F77_FCN (dgehrd) (const int*, const int*, const int*,
+                        double*, const int*, double*, double*,
+                        const int*, int*, long, long);
+
+  int F77_FCN (dorghr) (const int*, const int*, const int*,
+                        double*, const int*, double*, double*,
+                        const int*, int*, long, long);
+
+  int F77_FCN (dgesvd) (const char*, const char*, const int*,
+			const int*, double*, const int*, double*,
+			double*, const int*, double*, const int*,
+			double*, const int*, int*, long, long);
+
+  int F77_FCN (dpotrf) (const char*, const int*, double*, const int*,
+			int*, long);
+
+//
+// fortran functions for generalized eigenvalue problems
+//
+  int F77_FCN (reduce) (const int*, const int*, double*,
+	   	        const int*, double*,
+			int*, int*, double*, double*);
+
+  int F77_FCN (scaleg) (const int*, const int*, double*,
+	   	        const int*, double*,
+			const int*, const int*, double*, double*, double*);
+
+  int F77_FCN (gradeq) (const int*, const int*, double*,
+	   	        const int*, double*,
+			int*, int*, double*, double*);
+
+/*
+ * f2c translates complex*16 as
+ *
+ *   typedef struct { doublereal re, im; } doublecomplex;
+ *
+ * and Complex.h from libg++ uses
+ *
+ *   protected:
+ *     double re;
+ *     double im;
+ *
+ * as the only data members, so this should work (fingers crossed that
+ * things don't change).
+ */
+
+  int F77_FCN (zgesv) (const int*, const int*, Complex*, const int*,
+		       int*, Complex*, const int*, int*);
+
+  int F77_FCN (zgeqrf) (const int*, const int*, Complex*, const int*,
+			Complex*, Complex*, const int*, int*);
+
+  int F77_FCN (zgeesx) (const char*, const char*, int (*)(), const char*,
+			const int*, Complex*, const int*, int*,
+			Complex*, Complex*, const int*, double*, double*,
+			Complex*, const int*, double*, int*, int*,
+			long, long);
+
+  int F77_FCN (zgebal) (const char*, const int*, Complex*, const int*,
+                        int*, int*, double*, int*, long, long);
+ 
+  int F77_FCN (zgebak) (const char*, const char*, const int*, const int*,
+			const int*, double*, const int*, Complex*, 
+			const int*, int*, long, long);
+
+  int F77_FCN (zgehrd) (const int*, const int*, const int*, Complex*,
+                        const int*, Complex*, Complex*, const int*,
+                        int*, long, long);
+ 
+  int F77_FCN (zunghr) (const int*, const int*, const int*, Complex*,
+                        const int*, Complex*, Complex*, const int*,
+                        int*, long, long);
+
+  int F77_FCN (zungqr) (const int*, const int*, const int*, Complex*,
+			const int*, Complex*, Complex*, const int*, int*);
+
+  int F77_FCN (zgeev) (const char*, const char*, const int*, Complex*,
+		       const int*, Complex*, Complex*, const int*,
+		       Complex*, const int*, Complex*, const int*,
+		       double*, int*, long, long);
+
+  int F77_FCN (zgesvd) (const char*, const char*, const int*,
+			const int*, Complex*, const int*, double*,
+			Complex*, const int*, Complex*, const int*,
+			Complex*, const int*, double*, int*, long, long);
+
+  int F77_FCN (zpotrf) (const char*, const int*, Complex*, const int*,
+			int*, long);
+}
 
 /*
  * AEPBALANCE operations
@@ -163,9 +286,9 @@
 
   if (*balance_job == 'P' || *balance_job == 'B')
     {
-      F77_FCN(reduce)(&n, &n, balanced_a_mat.fortran_vec (),
-		      &n, balanced_b_mat.fortran_vec (), &ilo, &ihi,
-		      cscale, wk.fortran_vec ());
+      F77_FCN (reduce) (&n, &n, balanced_a_mat.fortran_vec (),
+			&n, balanced_b_mat.fortran_vec (), &ilo, &ihi,
+			cscale, wk.fortran_vec ());
     }
   else
     {
@@ -180,9 +303,9 @@
 
   if ((*balance_job == 'S' || *balance_job == 'B') && ilo != ihi)
     {
-      F77_FCN(scaleg)(&n, &n, balanced_a_mat.fortran_vec (), 
-		      &n, balanced_b_mat.fortran_vec (), &ilo, &ihi,
-		      cscale, cperm, wk.fortran_vec ());
+      F77_FCN (scaleg) (&n, &n, balanced_a_mat.fortran_vec (), 
+			&n, balanced_b_mat.fortran_vec (), &ilo, &ihi,
+			cscale, cperm, wk.fortran_vec ());
     }
   else
     {
@@ -400,15 +523,15 @@
    F77_FCN (zgebal) (&job, &n, h, &n, &ilo, &ihi, scale, &info, 1L, 1L);
 
    F77_FCN (zgehrd) (&n, &ilo, &ihi, h, &n, tau, work, &lwork, &info, 1L,
-                   1L);
+		     1L);
 
    copy(z,h,n*n);
 
    F77_FCN (zunghr) (&n, &ilo, &ihi, z, &n, tau, work, &lwork, &info, 1L,
-                   1L);
+		     1L);
 
    F77_FCN (zgebak) (&job, &side, &n, &ilo, &ihi, scale, &n, z, &n, &info,
-		   1L, 1L); 
+		     1L, 1L); 
 
    hess_mat = ComplexMatrix (h,n,n);
    unitary_hess_mat = ComplexMatrix (z,n,n);