diff liboctave/CMatrix.cc @ 6207:3c92b8d892dd

[project @ 2006-12-06 20:19:14 by dbateman]
author dbateman
date Wed, 06 Dec 2006 20:19:16 +0000
parents b3c425131211
children 15b299f6803d
line wrap: on
line diff
--- a/liboctave/CMatrix.cc	Wed Dec 06 20:10:03 2006 +0000
+++ b/liboctave/CMatrix.cc	Wed Dec 06 20:19:16 2006 +0000
@@ -41,6 +41,7 @@
 #include "CmplxDET.h"
 #include "CmplxSCHUR.h"
 #include "CmplxSVD.h"
+#include "CmplxCHOL.h"
 #include "f77-fcn.h"
 #include "lo-error.h"
 #include "lo-ieee.h"
@@ -142,6 +143,13 @@
 			     F77_CHAR_ARG_LEN_DECL);
 
   F77_RET_T
+  F77_FUNC (ztrtri, ZTRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, 
+			     const octave_idx_type&, const Complex*, 
+			     const octave_idx_type&, octave_idx_type& 
+			     F77_CHAR_ARG_LEN_DECL
+			     F77_CHAR_ARG_LEN_DECL);
+
+  F77_RET_T
   F77_FUNC (ztrcon, ZTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, 
 			     F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, 
 			     const Complex*, const octave_idx_type&, double&,
@@ -959,19 +967,94 @@
 {
   octave_idx_type info;
   double rcond;
-  return inverse (info, rcond, 0, 0);
+  MatrixType mattype (*this);
+  return inverse (mattype, info, rcond, 0, 0);
+}
+
+ComplexMatrix
+ComplexMatrix::inverse (MatrixType &mattype) const
+{
+  octave_idx_type info;
+  double rcond;
+  return inverse (mattype, info, rcond, 0, 0);
+}
+
+ComplexMatrix
+ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info) const
+{
+  double rcond;
+  return inverse (mattype, info, rcond, 0, 0);
 }
 
 ComplexMatrix
-ComplexMatrix::inverse (octave_idx_type& info) const
+ComplexMatrix::tinverse (MatrixType &mattype, octave_idx_type& info,
+			 double& rcond, int force, int calc_cond) const
 {
-  double rcond;
-  return inverse (info, rcond, 0, 0);
+  ComplexMatrix retval;
+
+  octave_idx_type nr = rows ();
+  octave_idx_type nc = cols ();
+
+  if (nr != nc || nr == 0 || nc == 0)
+    (*current_liboctave_error_handler) ("inverse requires square matrix");
+  else
+    {
+      int typ = mattype.type ();
+      char uplo = (typ == MatrixType::Lower ? 'L' : 'U');
+      char udiag = 'N';
+      retval = *this;
+      Complex *tmp_data = retval.fortran_vec ();
+
+      F77_XFCN (ztrtri, ZTRTRI, (F77_CONST_CHAR_ARG2 (&uplo, 1),
+				 F77_CONST_CHAR_ARG2 (&udiag, 1),
+				 nr, tmp_data, nr, info 
+				 F77_CHAR_ARG_LEN (1)
+				 F77_CHAR_ARG_LEN (1)));
+
+      if (f77_exception_encountered)
+	(*current_liboctave_error_handler) ("unrecoverable error in ztrtri");
+      else
+	{
+	  // Throw-away extra info LAPACK gives so as to not change output.
+	  rcond = 0.0;
+	  if (info != 0) 
+	    info = -1;
+	  else if (calc_cond) 
+	    {
+	      octave_idx_type ztrcon_info = 0;
+	      char job = '1';
+
+	      OCTAVE_LOCAL_BUFFER (Complex, cwork, 2 * nr);
+	      OCTAVE_LOCAL_BUFFER (double, rwork, nr);
+
+	      F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&job, 1),
+					 F77_CONST_CHAR_ARG2 (&uplo, 1),
+					 F77_CONST_CHAR_ARG2 (&udiag, 1),
+					 nr, tmp_data, nr, rcond, 
+					 cwork, rwork, ztrcon_info 
+					 F77_CHAR_ARG_LEN (1)
+					 F77_CHAR_ARG_LEN (1)
+					 F77_CHAR_ARG_LEN (1)));
+
+	      if (f77_exception_encountered)
+		(*current_liboctave_error_handler) 
+		  ("unrecoverable error in ztrcon");
+
+	      if (ztrcon_info != 0) 
+		info = -1;
+	    }
+	}
+
+      if (info == -1 && ! force)
+	retval = *this; // Restore matrix contents.
+    }
+
+  return retval;
 }
 
 ComplexMatrix
-ComplexMatrix::inverse (octave_idx_type& info, double& rcond, int force, 
-			int calc_cond) const
+ComplexMatrix::finverse (MatrixType &mattype, octave_idx_type& info,
+			 double& rcond, int force, int calc_cond) const
 {
   ComplexMatrix retval;
 
@@ -1062,12 +1145,45 @@
 		info = -1;
 	    }
 	}
+
+      if (info != 0)
+	mattype.mark_as_rectangular();
     }
   
   return retval;
 }
 
 ComplexMatrix
+ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info,
+			double& rcond, int force, int calc_cond) const
+{
+  int typ = mattype.type (false);
+  ComplexMatrix ret;
+
+  if (typ == MatrixType::Unknown)
+    typ = mattype.type (*this);
+
+  if (typ == MatrixType::Upper || typ == MatrixType::Lower)
+    ret = tinverse (mattype, info, rcond, force, calc_cond);
+  else if (typ != MatrixType::Rectangular)
+    {
+      if (mattype.is_hermitian ())
+	{
+	  ComplexCHOL chol (*this, info);
+	  if (info == 0)
+	    ret = chol.inverse ();
+	  else
+	    mattype.mark_as_unsymmetric ();
+	}
+
+      if (!mattype.is_hermitian ())
+	ret = finverse(mattype, info, rcond, force, calc_cond);
+    }
+
+  return ret;
+}
+
+ComplexMatrix
 ComplexMatrix::pseudo_inverse (double tol) const
 {
   ComplexMatrix retval;