Mercurial > hg > octave-lyh
diff liboctave/CMatrix.cc @ 7072:b48d486f641d
[project @ 2007-10-26 15:52:57 by jwe]
author | jwe |
---|---|
date | Fri, 26 Oct 2007 15:52:58 +0000 |
parents | c3b479e753dd |
children | 0bade2dc44a1 |
line wrap: on
line diff
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -120,10 +120,17 @@ F77_CHAR_ARG_LEN_DECL); F77_RET_T - F77_FUNC (zgelss, ZGELSS) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + F77_FUNC (zgelsy, ZGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + Complex*, const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, + Complex*, const octave_idx_type&, double*, octave_idx_type&); + + F77_RET_T + F77_FUNC (zgelsd, ZGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, double*, double&, octave_idx_type&, - Complex*, const octave_idx_type&, double*, octave_idx_type&); + Complex*, const octave_idx_type&, double*, + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, @@ -2436,62 +2443,63 @@ retval = ComplexMatrix (n, b.cols (), Complex (0.0, 0.0)); else { + volatile octave_idx_type minmn = (m < n ? m : n); + octave_idx_type maxmn = m > n ? m : n; + double rcond = -1.0; + + if (m != n) + { + retval = ComplexMatrix (maxmn, nrhs); + + for (octave_idx_type j = 0; j < nrhs; j++) + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i, j) = b.elem (i, j); + } + else + retval = b; + ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); - octave_idx_type nrr = m > n ? m : n; - ComplexMatrix result (nrr, nrhs); - - for (octave_idx_type j = 0; j < nrhs; j++) - for (octave_idx_type i = 0; i < m; i++) - result.elem (i, j) = b.elem (i, j); - - Complex *presult = result.fortran_vec (); - - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); + Complex *pretval = retval.fortran_vec (); + Array<double> s (minmn); double *ps = s.fortran_vec (); - double rcond = -1.0; - - octave_idx_type lrwork = (5 * (m < n ? m : n)) - 4; - lrwork = lrwork > 1 ? lrwork : 1; - Array<double> rwork (lrwork); - double *prwork = rwork.fortran_vec (); - - // Ask ZGELSS what the dimension of WORK should be. - + // Ask ZGELSD what the dimension of WORK should be. octave_idx_type lwork = -1; Array<Complex> work (1); - - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, - work.fortran_vec (), lwork, prwork, - info)); + Array<double> rwork (1); + Array<octave_idx_type> iwork (1); + + F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, + ps, rcond, rank, work.fortran_vec (), + lwork, rwork.fortran_vec (), + iwork.fortran_vec (), info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgelss"); + (*current_liboctave_error_handler) + ("unrecoverable error in zgelsd"); else { lwork = static_cast<octave_idx_type> (std::real (work(0))); work.resize (lwork); - - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, - work.fortran_vec (), lwork, - prwork, info)); + rwork.resize (static_cast<octave_idx_type> (rwork(0))); + iwork.resize (iwork(0)); + + F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, + maxmn, ps, rcond, rank, + work.fortran_vec (), lwork, + rwork.fortran_vec (), + iwork.fortran_vec (), info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgelss"); - else - { - retval.resize (n, nrhs); - for (octave_idx_type j = 0; j < nrhs; j++) - for (octave_idx_type i = 0; i < n; i++) - retval.elem (i, j) = result.elem (i, j); - } + (*current_liboctave_error_handler) + ("unrecoverable error in zgelsd"); + else if (rank < minmn) + (*current_liboctave_warning_handler) + ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", + m, n, rank, rcond); } } @@ -2552,60 +2560,62 @@ retval = ComplexColumnVector (n, Complex (0.0, 0.0)); else { + volatile octave_idx_type minmn = (m < n ? m : n); + octave_idx_type maxmn = m > n ? m : n; + double rcond = -1.0; + + if (m != n) + { + retval = ComplexColumnVector (maxmn); + + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i) = b.elem (i); + } + else + retval = b; + ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); - octave_idx_type nrr = m > n ? m : n; - ComplexColumnVector result (nrr); - - for (octave_idx_type i = 0; i < m; i++) - result.elem (i) = b.elem (i); - - Complex *presult = result.fortran_vec (); - - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); + Complex *pretval = retval.fortran_vec (); + Array<double> s (minmn); double *ps = s.fortran_vec (); - double rcond = -1.0; - - octave_idx_type lrwork = (5 * (m < n ? m : n)) - 4; - lrwork = lrwork > 1 ? lrwork : 1; - Array<double> rwork (lrwork); - double *prwork = rwork.fortran_vec (); - - // Ask ZGELSS what the dimension of WORK should be. - + // Ask ZGELSD what the dimension of WORK should be. octave_idx_type lwork = -1; Array<Complex> work (1); - - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, - work.fortran_vec (), lwork, prwork, - info)); + Array<double> rwork (1); + Array<octave_idx_type> iwork (1); + + F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, + ps, rcond, rank, work.fortran_vec (), + lwork, rwork.fortran_vec (), + iwork.fortran_vec (), info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgelss"); + (*current_liboctave_error_handler) + ("unrecoverable error in zgelsd"); else { - lwork = static_cast<int> (std::real (work(0))); + lwork = static_cast<octave_idx_type> (std::real (work(0))); work.resize (lwork); - - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, - work.fortran_vec (), lwork, - prwork, info)); + rwork.resize (static_cast<octave_idx_type> (rwork(0))); + iwork.resize (iwork(0)); + + F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, + maxmn, ps, rcond, rank, + work.fortran_vec (), lwork, + rwork.fortran_vec (), + iwork.fortran_vec (), info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgelss"); - else - { - retval.resize (n); - for (octave_idx_type i = 0; i < n; i++) - retval.elem (i) = result.elem (i); - } + (*current_liboctave_error_handler) + ("unrecoverable error in zgelsd"); + else if (rank < minmn) + (*current_liboctave_warning_handler) + ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", + m, n, rank, rcond); } }