Mercurial > octave
diff liboctave/EIG.cc @ 2815:33486d9e2d00
[project @ 1997-03-14 08:24:46 by jwe]
author | jwe |
---|---|
date | Fri, 14 Mar 1997 08:25:58 +0000 |
parents | eedc2f3f61f7 |
children | 8b262e771614 |
line wrap: on
line diff
--- a/liboctave/EIG.cc Fri Mar 14 04:31:14 1997 +0000 +++ b/liboctave/EIG.cc Fri Mar 14 08:25:58 1997 +0000 @@ -29,6 +29,7 @@ #endif #include "EIG.h" +#include "dColVector.h" #include "f77-fcn.h" #include "lo-error.h" @@ -45,11 +46,22 @@ Complex*, const int&, Complex*, const int&, Complex*, const int&, double*, int&, long, long); + + int F77_FCN (dsyev, DSYEV) (const char*, const char*, const int&, + double*, const int&, double*, double*, + const int&, int&, long, long); + + int F77_FCN (zheev, ZHEEV) (const char*, const char*, const int&, + Complex*, const int&, double*, Complex*, + const int&, double*, int&, long, long); } int EIG::init (const Matrix& a) { + if (a.is_symmetric ()) + return symmetric_init (a); + int n = a.rows (); if (n != a.cols ()) @@ -58,7 +70,7 @@ return -1; } - int info; + int info = 0; Matrix atmp = a; double *tmp_data = atmp.fortran_vec (); @@ -72,8 +84,10 @@ Matrix vr (n, n); double *pvr = vr.fortran_vec (); + // XXX FIXME XXX -- it might be possible to choose a better value of + // lwork that would result in more efficient computations. + int lwork = 8*n; - Array<double> work (lwork); double *pwork = work.fortran_vec (); @@ -83,40 +97,95 @@ F77_XFCN (dgeev, DGEEV, ("N", "V", n, tmp_data, n, pwr, pwi, dummy, idummy, pvr, n, pwork, lwork, info, 1L, 1L)); - if (f77_exception_encountered) + if (f77_exception_encountered || info < 0) (*current_liboctave_error_handler) ("unrecoverable error in dgeev"); else { - lambda.resize (n); - v.resize (n, n); + if (info > 0) + (*current_liboctave_error_handler) ("dgeev failed to converge"); + else + { + lambda.resize (n); + v.resize (n, n); - for (int j = 0; j < n; j++) - { - if (wi.elem (j) == 0.0) + for (int j = 0; j < n; j++) { - lambda.elem (j) = Complex (wr.elem (j)); - for (int i = 0; i < n; i++) - v.elem (i, j) = vr.elem (i, j); - } - else - { - if (j+1 >= n) + if (wi.elem (j) == 0.0) + { + lambda.elem (j) = Complex (wr.elem (j)); + for (int i = 0; i < n; i++) + v.elem (i, j) = vr.elem (i, j); + } + else { - (*current_liboctave_error_handler) ("EIG: internal error"); - return -1; + if (j+1 >= n) + { + (*current_liboctave_error_handler) + ("EIG: internal error"); + return -1; + } + + for (int i = 0; i < n; i++) + { + lambda.elem(j) = Complex (wr.elem(j), wi.elem(j)); + lambda.elem(j+1) = Complex (wr.elem(j+1), wi.elem(j+1)); + double real_part = vr.elem (i, j); + double imag_part = vr.elem (i, j+1); + v.elem (i, j) = Complex (real_part, imag_part); + v.elem (i, j+1) = Complex (real_part, -imag_part); + } + j++; } + } + } + } + + return info; +} + +int +EIG::symmetric_init (const Matrix& a) +{ + int n = a.rows (); - for (int i = 0; i < n; i++) - { - lambda.elem (j) = Complex (wr.elem (j), wi.elem (j)); - lambda.elem (j+1) = Complex (wr.elem (j+1), wi.elem (j+1)); - double real_part = vr.elem (i, j); - double imag_part = vr.elem (i, j+1); - v.elem (i, j) = Complex (real_part, imag_part); - v.elem (i, j+1) = Complex (real_part, -imag_part); - } - j++; - } + if (n != a.cols ()) + { + (*current_liboctave_error_handler) ("EIG requires square matrix"); + return -1; + } + + int info = 0; + + Matrix atmp = a; + double *tmp_data = atmp.fortran_vec (); + + Array<double> wr (n); + double *pwr = wr.fortran_vec (); + + // XXX FIXME XXX -- it might be possible to choose a better value of + // lwork that would result in more efficient computations. + + int lwork = 8*n; + Array<double> work (lwork); + double *pwork = work.fortran_vec (); + + F77_XFCN (dsyev, DSYEV, ("V", "U", n, tmp_data, n, pwr, pwork, + lwork, info, 1L, 1L)); + + if (f77_exception_encountered || info < 0) + (*current_liboctave_error_handler) ("unrecoverable error in dsyev"); + else + { + if (info > 0) + (*current_liboctave_error_handler) ("dsyev failed to converge"); + else + { + lambda.resize (n); + + for (int j = 0; j < n; j++) + lambda.elem (j) = Complex (wr.elem (j)); + + v = atmp; } } @@ -126,6 +195,9 @@ int EIG::init (const ComplexMatrix& a) { + if (a.is_hermitian ()) + return hermitian_init (a); + int n = a.rows (); if (n != a.cols ()) @@ -134,33 +206,89 @@ return -1; } - int info; - - lambda.resize (n); - v.resize (n, n); - - Complex *pw = lambda.fortran_vec (); - Complex *pvr = v.fortran_vec (); + int info = 0; ComplexMatrix atmp = a; Complex *tmp_data = atmp.fortran_vec (); + ComplexColumnVector w (n); + Complex *pw = w.fortran_vec (); + + ComplexMatrix vtmp (n, n); + Complex *pv = vtmp.fortran_vec (); + + // XXX FIXME XXX -- it might be possible to choose a better value of + // lwork that would result in more efficient computations. + int lwork = 8*n; - Array<Complex> work (lwork); Complex *pwork = work.fortran_vec (); - Array<double> rwork (4*n); + int lrwork = 2*n; + Array<double> rwork (lrwork); double *prwork = rwork.fortran_vec (); Complex *dummy = 0; int idummy = 1; F77_XFCN (zgeev, ZGEEV, ("N", "V", n, tmp_data, n, pw, dummy, idummy, - pvr, n, pwork, lwork, prwork, info, 1L, 1L)); + pv, n, pwork, lwork, prwork, info, 1L, 1L)); + + if (f77_exception_encountered || info < 0) + (*current_liboctave_error_handler) ("unrecoverable error in zgeev"); + else if (info > 0) + (*current_liboctave_error_handler) ("zgeev failed to converge"); + else + { + lambda = w; + v = vtmp; + } + + return info; +} + +int +EIG::hermitian_init (const ComplexMatrix& a) +{ + int n = a.rows (); + + if (n != a.cols ()) + { + (*current_liboctave_error_handler) ("EIG requires square matrix"); + return -1; + } + + int info = 0; - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgeev"); + ComplexMatrix atmp = a; + Complex *tmp_data = atmp.fortran_vec (); + + ColumnVector w (n); + double *pw = w.fortran_vec (); + + // XXX FIXME XXX -- it might be possible to choose a better value of + // lwork that would result in more efficient computations. + + int lwork = 8*n; + Array<Complex> work (lwork); + Complex *pwork = work.fortran_vec (); + + int lrwork = 3*n; + Array<double> rwork (lrwork); + double *prwork = rwork.fortran_vec (); + + F77_XFCN (zheev, ZHEEV, ("V", "U", n, tmp_data, n, pw, pwork, + lwork, prwork, info, 1L, 1L)); + + if (f77_exception_encountered || info < 0) + (*current_liboctave_error_handler) ("unrecoverable error in zheev"); + else if (info > 0) + (*current_liboctave_error_handler) ("zheev failed to converge"); + else + { + lambda = w; + v = atmp; + } return info; }