Mercurial > hg > octave-lyh
diff liboctave/CMatrix.cc @ 8392:c187f0e3a7ee
use m-file implementation for expm
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Wed, 10 Dec 2008 11:55:23 +0100 |
parents | 25bc2d31e1bf |
children | 5114ea5a41b5 |
line wrap: on
line diff
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -2926,194 +2926,6 @@ rcon); } -ComplexMatrix -ComplexMatrix::expm (void) const -{ - ComplexMatrix retval; - - ComplexMatrix m = *this; - - octave_idx_type nc = columns (); - - // Preconditioning step 1: trace normalization to reduce dynamic - // range of poles, but avoid making stable eigenvalues unstable. - - // trace shift value - Complex trshift = 0.0; - - for (octave_idx_type i = 0; i < nc; i++) - trshift += m.elem (i, i); - - trshift /= nc; - - if (trshift.real () < 0.0) - { - trshift = trshift.imag (); - if (trshift.real () > 709.0) - trshift = 709.0; - } - - for (octave_idx_type i = 0; i < nc; i++) - m.elem (i, i) -= trshift; - - // Preconditioning step 2: eigenvalue balancing. - // code follows development in AEPBAL - - Complex *mp = m.fortran_vec (); - - octave_idx_type info, ilo, ihi,ilos,ihis; - Array<double> dpermute (nc); - Array<double> dscale (nc); - - // FIXME -- should pass job as a parameter in expm - - // Permute first - char job = 'P'; - F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, mp, nc, ilo, ihi, - dpermute.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); - - // then scale - job = 'S'; - F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, mp, nc, ilos, ihis, - dscale.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); - - // Preconditioning step 3: scaling. - - ColumnVector work (nc); - double inf_norm; - - F77_XFCN (xzlange, XZLANGE, (F77_CONST_CHAR_ARG2 ("I", 1), - nc, nc, m.fortran_vec (), nc, - work.fortran_vec (), inf_norm - F77_CHAR_ARG_LEN (1))); - - int sqpow = (inf_norm > 0.0 - ? static_cast<int> (1.0 + log (inf_norm) / log (2.0)) : 0); - - // Check whether we need to square at all. - - if (sqpow < 0) - sqpow = 0; - - if (sqpow > 0) - { - if (sqpow > 1023) - sqpow = 1023; - - double scale_factor = 1.0; - for (octave_idx_type 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); - Complex *pnpp = npp.fortran_vec (); - ComplexMatrix dpp = npp; - Complex *pdpp = dpp.fortran_vec (); - - // Now powers a^8 ... a^1. - - int minus_one_j = -1; - for (octave_idx_type j = 7; j >= 0; j--) - { - for (octave_idx_type i = 0; i < nc; i++) - { - octave_idx_type k = i * nc + i; - pnpp[k] += padec[j]; - pdpp[k] += minus_one_j * padec[j]; - } - - npp = m * npp; - pnpp = npp.fortran_vec (); - - dpp = m * dpp; - pdpp = dpp.fortran_vec (); - - minus_one_j *= -1; - } - - // Zero power. - - dpp = -dpp; - for (octave_idx_type j = 0; j < nc; j++) - { - npp.elem (j, j) += 1.0; - dpp.elem (j, j) += 1.0; - } - - // Compute pade approximation = inverse (dpp) * npp. - - double rcon; - retval = dpp.solve (npp, info, rcon, solve_singularity_warning); - - if (info < 0) - return retval; - - // Reverse preconditioning step 3: repeated squaring. - - while (sqpow) - { - retval = retval * retval; - sqpow--; - } - - // Reverse preconditioning step 2: inverse balancing. - // Done in two steps: inverse scaling, then inverse permutation - - // inverse scaling (diagonal transformation) - for (octave_idx_type i = 0; i < nc; i++) - for (octave_idx_type j = 0; j < nc; j++) - retval(i,j) *= dscale(i) / dscale(j); - - OCTAVE_QUIT; - - // construct balancing permutation vector - Array<octave_idx_type> iperm (nc); - for (octave_idx_type i = 0; i < nc; i++) - iperm(i) = i; // identity permutation - - // trailing permutations must be done in reverse order - for (octave_idx_type i = nc - 1; i >= ihi; i--) - { - octave_idx_type swapidx = static_cast<octave_idx_type> (dpermute(i)) - 1; - octave_idx_type tmp = iperm(i); - iperm(i) = iperm(swapidx); - iperm(swapidx) = tmp; - } - - // leading permutations in forward order - for (octave_idx_type i = 0; i < (ilo-1); i++) - { - octave_idx_type swapidx = static_cast<octave_idx_type> (dpermute(i)) - 1; - octave_idx_type tmp = iperm(i); - iperm(i) = iperm (swapidx); - iperm(swapidx) = tmp; - } - - // construct inverse balancing permutation vector - Array<octave_idx_type> invpvec (nc); - for (octave_idx_type i = 0; i < nc; i++) - invpvec(iperm(i)) = i; // Thanks to R. A. Lippert for this method - - OCTAVE_QUIT; - - ComplexMatrix tmpMat = retval; - for (octave_idx_type i = 0; i < nc; i++) - for (octave_idx_type j = 0; j < nc; j++) - retval(i,j) = tmpMat(invpvec(i),invpvec(j)); - - // Reverse preconditioning step 1: fix trace normalization. - - return exp (trshift) * retval; -} - // column vector by row vector -> matrix operations ComplexMatrix