Mercurial > hg > octave-nkf
diff liboctave/CMatrix.cc @ 1819:8b8498bf8ec5
[project @ 1996-01-31 11:29:17 by jwe]
author | jwe |
---|---|
date | Wed, 31 Jan 1996 11:31:00 +0000 |
parents | 0c6d3b73bf69 |
children | 2ffe49eb95a5 |
line wrap: on
line diff
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -35,7 +35,9 @@ #include <sys/types.h> // XXX FIXME XXX +#include "CmplxAEPBAL.h" #include "CmplxDET.h" +#include "CmplxSCHUR.h" #include "CmplxSVD.h" #include "f77-uscore.h" #include "lo-error.h" @@ -78,6 +80,20 @@ int F77_FCN (cfftf, CFFTF) (const int&, Complex*, Complex*); int F77_FCN (cfftb, CFFTB) (const int&, Complex*, Complex*); + + int F77_FCN (zlartg, ZLARTG) (const Complex&, const Complex&, + double&, Complex&, Complex&); + + int F77_FCN (ztrsyl, ZTRSYL) (const char*, const char*, const int&, + const int&, const int&, + const Complex*, const int&, + const Complex*, const int&, + const Complex*, const int&, double&, + int&, long, long); + + double F77_FCN (zlange, ZLANGE) (const char*, const int&, + const int&, const Complex*, + const int&, double*); } // Complex Matrix class @@ -1385,6 +1401,124 @@ return retval; } +// Constants for matrix exponential calculation. + +static double padec [] = +{ + 5.0000000000000000e-1, + 1.1666666666666667e-1, + 1.6666666666666667e-2, + 1.6025641025641026e-3, + 1.0683760683760684e-4, + 4.8562548562548563e-6, + 1.3875013875013875e-7, + 1.9270852604185938e-9, +}; + +ComplexMatrix +ComplexMatrix::expm (void) const +{ + ComplexMatrix retval; + + ComplexMatrix m = *this; + + int nc = columns (); + + // trace shift value + Complex trshift = 0.0; + + // Preconditioning step 1: trace normalization. + + for (int i = 0; i < nc; i++) + trshift += m.elem (i, i); + + trshift /= nc; + + for (int i = 0; i < nc; i++) + m.elem (i, i) -= trshift; + + // Preconditioning step 2: eigenvalue balancing. + + ComplexAEPBALANCE mbal (m, "B"); + m = mbal.balanced_matrix (); + ComplexMatrix d = mbal.balancing_matrix (); + + // Preconditioning step 3: scaling. + + ColumnVector work (nc); + double inf_norm + = F77_FCN (zlange, ZLANGE) ("I", nc, nc, m.fortran_vec (), nc, + work.fortran_vec ()); + + int sqpow = (int) (inf_norm > 0.0 + ? (1.0 + log (inf_norm) / log (2.0)) + : 0.0); + + // Check whether we need to square at all. + + if (sqpow < 0) + sqpow = 0; + + if (sqpow > 0) + { + double scale_factor = 1.0; + for (int i = 0; i < sqpow; i++) + scale_factor *= 2.0; + + m = m / scale_factor; + } + + // npp, dpp: pade' approx polynomial matrices. + + ComplexMatrix npp (nc, nc, 0.0); + ComplexMatrix dpp = npp; + + // Now powers a^8 ... a^1. + + int minus_one_j = -1; + for (int j = 7; j >= 0; j--) + { + npp = m * npp + m * padec[j]; + dpp = m * dpp + m * (minus_one_j * padec[j]); + minus_one_j *= -1; + } + + // Zero power. + + dpp = -dpp; + for (int j = 0; j < nc; j++) + { + npp.elem (j, j) += 1.0; + dpp.elem (j, j) += 1.0; + } + + // Compute pade approximation = inverse (dpp) * npp. + + retval = dpp.solve (npp); + + // Reverse preconditioning step 3: repeated squaring. + + while (sqpow) + { + retval = retval * retval; + sqpow--; + } + + // Reverse preconditioning step 2: inverse balancing. + // XXX FIXME XXX -- should probably do this with Lapack calls + // instead of a complete matrix inversion. + + retval = retval.transpose (); + d = d.transpose (); + retval = retval * d; + retval = d.solve (retval); + retval = retval.transpose (); + + // Reverse preconditioning step 1: fix trace normalization. + + return retval * exp (trshift); +} + // column vector by row vector -> matrix operations ComplexMatrix @@ -3372,6 +3506,70 @@ return is; } +ComplexMatrix +Givens (const Complex& x, const Complex& y) +{ + double cc; + Complex cs, temp_r; + + F77_FCN (zlartg, ZLARTG) (x, y, cc, cs, temp_r); + + ComplexMatrix g (2, 2); + + g.elem (0, 0) = cc; + g.elem (1, 1) = cc; + g.elem (0, 1) = cs; + g.elem (1, 0) = -conj (cs); + + return g; +} + +ComplexMatrix +Sylvester (const ComplexMatrix& a, const ComplexMatrix& b, + const ComplexMatrix& c) +{ + ComplexMatrix retval; + + // XXX FIXME XXX -- need to check that a, b, and c are all the same + // size. + + // Compute Schur decompositions + + ComplexSCHUR as (a, "U"); + ComplexSCHUR bs (b, "U"); + + // Transform c to new coordinates. + + ComplexMatrix ua = as.unitary_matrix (); + ComplexMatrix sch_a = as.schur_matrix (); + + ComplexMatrix ub = bs.unitary_matrix (); + ComplexMatrix sch_b = bs.schur_matrix (); + + ComplexMatrix cx = ua.hermitian () * c * ub; + + // Solve the sylvester equation, back-transform, and return the + // solution. + + int a_nr = a.rows (); + int b_nr = b.rows (); + + double scale; + int info; + + F77_FCN (ztrsyl, ZTRSYL) ("N", "N", 1, a_nr, b_nr, + sch_a.fortran_vec (), a_nr, + sch_b.fortran_vec (), b_nr, + cx.fortran_vec (), a_nr, scale, + info, 1L, 1L); + + // XXX FIXME XXX -- check info? + + retval = -ua * cx * ub.hermitian (); + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***