Mercurial > hg > octave-nkf
diff liboctave/CmplxSCHUR.cc @ 1929:908f5b6676d7
[project @ 1996-02-11 22:05:08 by jwe]
author | jwe |
---|---|
date | Sun, 11 Feb 1996 22:05:23 +0000 |
parents | 1281a23a34dd |
children | d20ab06301e8 |
line wrap: on
line diff
--- a/liboctave/CmplxSCHUR.cc +++ b/liboctave/CmplxSCHUR.cc @@ -37,7 +37,7 @@ extern "C" { int F77_FCN (zgeesx, ZGEESX) (const char*, const char*, - int (*)(const Complex&), + ComplexSCHUR::select_function, const char*, const int&, Complex*, const int&, int&, Complex*, Complex*, const int&, double&, double&, @@ -46,13 +46,13 @@ } static int -complex_select_ana (const Complex& a) +select_ana (const Complex& a) { return a.real () < 0.0; } static int -complex_select_dig (const Complex& a) +select_dig (const Complex& a) { return (abs (a) < 1.0); } @@ -62,6 +62,7 @@ { int a_nr = a.rows (); int a_nc = a.cols (); + if (a_nr != a_nc) { (*current_liboctave_error_handler) @@ -70,16 +71,19 @@ } char *jobvs = "V"; - char *sort; + char *sense = "N"; + char *sort = "N"; char ord_char = ord.empty () ? 'U' : ord[0]; if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - sort = "S"; - else - sort = "N"; + sort = "S"; - char *sense = "N"; + select_function selector= 0; + if (ord_char == 'A' || ord_char == 'a') + selector = select_ana; + else if (ord_char == 'D' || ord_char == 'd') + selector = select_dig; int n = a_nc; int lwork = 8 * n; @@ -88,49 +92,36 @@ double rconde; double rcondv; - double *rwork = new double [n]; + schur_mat = a; + unitary_mat.resize (n, n); + + Complex *s = schur_mat.fortran_vec (); + Complex *q = unitary_mat.fortran_vec (); + + Array<double> rwork (n); + double *prwork = rwork.fortran_vec (); + + Array<Complex> w (n); + Complex *pw = w.fortran_vec (); + + Array<Complex> work (lwork); + Complex *pwork = work.fortran_vec (); // bwork is not referenced for non-ordered Schur. - int *bwork = 0; - if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - bwork = new int [n]; + Array<int> bwork; - Complex *s = dup (a.data (), a.length ()); + if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') + bwork.resize (n); - Complex *work = new Complex [lwork]; - Complex *q = new Complex [n*n]; - Complex *w = new Complex [n]; + int *pbwork = bwork.fortran_vec (); - if (ord_char == 'A' || ord_char == 'a') - { - F77_FCN (zgeesx, ZGEESX) (jobvs, sort, complex_select_ana, - sense, n, s, n, sdim, w, q, n, rconde, - rcondv, work, lwork, rwork, bwork, - info, 1L, 1L); - } - else if (ord_char == 'D' || ord_char == 'd') - { - F77_FCN (zgeesx, ZGEESX) (jobvs, sort, complex_select_dig, - sense, n, s, n, sdim, w, q, n, rconde, - rcondv, work, lwork, rwork, bwork, - info, 1L, 1L); - } - else - { - F77_FCN (zgeesx, ZGEESX) (jobvs, sort, (void *) 0, sense, n, s, - n, sdim, w, q, n, rconde, rcondv, - work, lwork, rwork, bwork, info, 1L, - 1L); - } + F77_XFCN (zgeesx, ZGEESX, (jobvs, sort, selector, sense, n, s, n, + sdim, pw, q, n, rconde, rcondv, pwork, + lwork, prwork, pbwork, info, 1L, 1L)); - schur_mat = ComplexMatrix (s, n, n); - unitary_mat = ComplexMatrix (q, n, n); - - delete [] w; - delete [] work; - delete [] rwork; - delete [] bwork; + if (f77_exception_encountered) + (*current_liboctave_error_handler) ("unrecoverable error in zgeesx"); return info; }