Mercurial > octave-nkf
changeset 5681:233d98d95659
[project @ 2006-03-16 17:48:55 by dbateman]
| author | dbateman |
|---|---|
| date | Thu, 16 Mar 2006 17:48:56 +0000 |
| parents | cc6a965ae4ca |
| children | cbc323d109e4 |
| files | doc/ChangeLog doc/interpreter/images/sparseimages.m doc/interpreter/sparse.txi liboctave/CSparse.cc liboctave/CSparse.h liboctave/ChangeLog liboctave/MSparse.cc liboctave/Makefile.in liboctave/Sparse-op-defs.h liboctave/Sparse.cc liboctave/SparseCmplxQR.cc liboctave/SparseQR.cc liboctave/SparseType.cc liboctave/dSparse.cc liboctave/dSparse.h scripts/ChangeLog scripts/testfun/test.m src/ChangeLog src/DLD-FUNCTIONS/luinc.cc src/DLD-FUNCTIONS/matrix_type.cc src/DLD-FUNCTIONS/spqr.cc src/sparse-xdiv.cc test/build_sparse_tests.sh |
| diffstat | 23 files changed, 4473 insertions(+), 3252 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/ChangeLog Thu Mar 16 17:36:52 2006 +0000 +++ b/doc/ChangeLog Thu Mar 16 17:48:56 2006 +0000 @@ -1,3 +1,9 @@ +2006-03-16 David Bateman <dbateman@free.fr> + + * interpreter/images/sparseimages.m: set terminal type to dummy to + direct output to terminal rather than X11. + * interpreter/sparse.txi: Update docs for new QR solvers. + 2006-03-09 David Bateman <dbateman@free.fr> * interpreter/Makefile.in: Change order of commands in HTML/index.html
--- a/doc/interpreter/images/sparseimages.m Thu Mar 16 17:36:52 2006 +0000 +++ b/doc/interpreter/images/sparseimages.m Thu Mar 16 17:48:56 2006 +0000 @@ -1,4 +1,13 @@ function sparseimages(dirc,typ) + ## XXX FIXME XXX + ## How do we set terminal and direct the output to /dev/null without + ## gnuplot? Note that due to replot in print.m, the redirection to + ## /dev/null effectively doesn't work at the moment. + __gnuplot_set__ term dumb + [status, dummy] = fileattrib("/dev/null"); + if (status) + __gnuplot_set__ output '/dev/null' + endif plot(1) # FIXME bypass 2.9.4 bug!! if (strcmp(typ,"txt")) txtimages(15,dirc,typ);
--- a/doc/interpreter/sparse.txi Thu Mar 16 17:36:52 2006 +0000 +++ b/doc/interpreter/sparse.txi Thu Mar 16 17:48:56 2006 +0000 @@ -745,16 +745,23 @@ solvers can be entirely disabled by using @dfn{spparms} to set @code{bandden} to 1 (i.e. @code{spparms ("bandden", 1)}). -All of the solvers above, expect the banded solvers, calculate an -estimate of the condition number. This can be used to detect numerical -stability problems in the solution and force a minimum norm solution -to be used. However, for narrow banded matrices, the cost of -calculating the condition number is significant, and can in fact exceed -the cost of factoring the matrix. Therefore the condition number is -not calculated for banded matrices, and therefore unless the factorization -is exactly singular, these numerical instabilities won't be detected. -In cases where, this might be a problem the user is recommended to disable -the banded solvers as above, at a significant cost in terms of speed. +The QR solver factorizes the problem with a Dulmage-Mendhelsohn, to +seperate the problem into blocks that can be treated as over-determined, +multiple well determined blocks, and a final over-determined block. For +matrices with blocks of strongly connectted nodes this is a big win as +LU decomposition can be used for many blocks. It also significantly +improves the chance of finding a solution to over-determined problems +rather than just returning a vector of @dfn{NaN}'s. + +All of the solvers above, can calculate an estimate of the condition +number. This can be used to detect numerical stability problems in the +solution and force a minimum norm solution to be used. However, for +narrow banded, triangular or diagonal matrices, the cost of +calculating the condition number is significant, and can in fact +exceed the cost of factoring the matrix. Therefore the condition +number is not calculated in these case, and octave relies on simplier +techniques to detect sinular matrices or the underlying LAPACK code in +the case of banded matrices. The user can force the type of the matrix with the @code{matrix_type} function. This overcomes the cost of discovering the type of the matrix.
--- a/liboctave/CSparse.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/CSparse.cc Thu Mar 16 17:48:56 2006 +0000 @@ -47,6 +47,13 @@ #include "oct-sort.h" +// Define whether to use a basic QR solver or one that uses a Dulmange +// Mendelsohn factorization to seperate the problem into under-determined, +// well-determined and over-determined parts and solves them seperately +#ifndef USE_QRSOLVE +#include "sparse-dmsolve.cc" +#endif + // Fortran functions we call. extern "C" { @@ -82,7 +89,7 @@ F77_RET_T F77_FUNC (zpbcon, ZPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, - const double&, double&, Complex*, octave_idx_type*, octave_idx_type& + const double&, double&, Complex*, double*, octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T @@ -106,33 +113,33 @@ } SparseComplexMatrix::SparseComplexMatrix (const SparseMatrix& a) - : MSparse<Complex> (a.rows (), a.cols (), a.nzmax ()) + : MSparse<Complex> (a.rows (), a.cols (), a.nnz ()) { octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = a.nnz (); for (octave_idx_type i = 0; i < nc + 1; i++) cidx (i) = a.cidx (i); for (octave_idx_type i = 0; i < nz; i++) { - data (i) = a.data (i); + data (i) = Complex (a.data (i)); ridx (i) = a.ridx (i); } } SparseComplexMatrix::SparseComplexMatrix (const SparseBoolMatrix& a) - : MSparse<Complex> (a.rows (), a.cols (), a.nzmax ()) + : MSparse<Complex> (a.rows (), a.cols (), a.nnz ()) { octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = a.nnz (); for (octave_idx_type i = 0; i < nc + 1; i++) cidx (i) = a.cidx (i); for (octave_idx_type i = 0; i < nz; i++) { - data (i) = a.data (i); + data (i) = Complex (a.data (i)); ridx (i) = a.ridx (i); } } @@ -142,10 +149,10 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type nr_a = a.rows (); octave_idx_type nc_a = a.cols (); - octave_idx_type nz_a = a.nzmax (); + octave_idx_type nz_a = a.nnz (); if (nr != nr_a || nc != nc_a || nz != nz_a) return false; @@ -546,7 +553,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); SparseComplexMatrix retval (nc, nr, nz); OCTAVE_LOCAL_BUFFER (octave_idx_type, w, nr + 1); @@ -580,7 +587,7 @@ { octave_idx_type nr = a.rows (); octave_idx_type nc = a.cols (); - octave_idx_type nz = a.nzmax (); + octave_idx_type nz = a.nnz (); SparseComplexMatrix retval (nc, nr, nz); for (octave_idx_type i = 0; i < nc + 1; i++) @@ -713,7 +720,7 @@ if (typ == SparseType::Upper || typ == SparseType::Lower) { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type cx = 0; octave_idx_type nz2 = nz; retval = SparseComplexMatrix (nr, nc, nz2); @@ -798,7 +805,7 @@ } else { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type cx = 0; octave_idx_type nz2 = nz; retval = SparseComplexMatrix (nr, nc, nz2); @@ -1118,8 +1125,8 @@ ComplexMatrix SparseComplexMatrix::dsolve (SparseType &mattype, const Matrix& b, - octave_idx_type& err, - double& rcond, solve_singularity_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, bool calc_cond) const { ComplexMatrix retval; @@ -1151,16 +1158,21 @@ for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) retval(k,j) = b(ridx(i),j) / data (i); - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = std::abs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = std::abs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.0; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1172,7 +1184,8 @@ SparseComplexMatrix SparseComplexMatrix::dsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler) const + solve_singularity_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1194,7 +1207,7 @@ typ == SparseType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; @@ -1204,6 +1217,8 @@ { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) { + if (b.ridx(i) >= nm) + break; retval.xridx (ii) = b.ridx(i); retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); } @@ -1232,16 +1247,21 @@ retval.xcidx(j+1) = ii; } - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = std::abs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = std::abs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.0; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1253,7 +1273,8 @@ ComplexMatrix SparseComplexMatrix::dsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler) const + solve_singularity_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1285,16 +1306,21 @@ for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) retval(k,j) = b(ridx(i),j) / data (i); - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nr; i++) - { - double tmp = std::abs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nr; i++) + { + double tmp = std::abs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.0; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1306,7 +1332,8 @@ SparseComplexMatrix SparseComplexMatrix::dsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler) const + solve_singularity_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1328,7 +1355,7 @@ typ == SparseType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; @@ -1338,6 +1365,8 @@ { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) { + if (b.ridx(i) >= nm) + break; retval.xridx (ii) = b.ridx(i); retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); } @@ -1366,16 +1395,21 @@ retval.xcidx(j+1) = ii; } - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = std::abs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = std::abs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.0; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1387,7 +1421,8 @@ ComplexMatrix SparseComplexMatrix::utsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1411,23 +1446,26 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Upper) { retval.resize (nc, b_nc); octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (Complex, work, nr); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); for (octave_idx_type j = 0; j < b_nc; j++) { @@ -1442,7 +1480,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1463,38 +1502,42 @@ retval (perm[i], j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + Complex tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -1513,7 +1556,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1533,45 +1577,51 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -1585,7 +1635,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -1602,7 +1655,8 @@ SparseComplexMatrix SparseComplexMatrix::utsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1625,20 +1679,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -1666,7 +1723,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1709,38 +1767,42 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + Complex tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -1758,7 +1820,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1800,45 +1863,51 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -1852,7 +1921,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -1868,7 +1940,8 @@ ComplexMatrix SparseComplexMatrix::utsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1892,16 +1965,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Upper) @@ -1923,7 +1999,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1944,38 +2021,42 @@ retval (perm[i], j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + Complex tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -1994,7 +2075,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2014,45 +2096,51 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2066,7 +2154,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2083,7 +2174,8 @@ SparseComplexMatrix SparseComplexMatrix::utsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -2106,20 +2198,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -2147,7 +2242,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2190,38 +2286,42 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + Complex tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2239,7 +2339,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2281,45 +2382,51 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - Complex tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2333,7 +2440,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2350,7 +2460,8 @@ ComplexMatrix SparseComplexMatrix::ltsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2374,16 +2485,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Lower) @@ -2413,7 +2527,7 @@ mini = i; } - if (minr != k) + if (minr != k || data (mini) == 0.) { err = -2; goto triangular_error; @@ -2436,49 +2550,55 @@ retval (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - Complex tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + Complex tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2496,7 +2616,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -2515,46 +2636,51 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - Complex tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; - + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2568,7 +2694,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2585,7 +2714,8 @@ SparseComplexMatrix SparseComplexMatrix::ltsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -2609,20 +2739,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -2654,7 +2787,7 @@ mini = i; } - if (minr != k) + if (minr != k || data (mini) == 0.) { err = -2; goto triangular_error; @@ -2699,49 +2832,55 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - Complex tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + Complex tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2759,7 +2898,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -2801,47 +2941,52 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - Complex tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2855,7 +3000,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2872,7 +3020,8 @@ ComplexMatrix SparseComplexMatrix::ltsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2896,16 +3045,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Lower) @@ -2935,7 +3087,7 @@ mini = i; } - if (minr != k) + if (minr != k || data (mini) == 0.) { err = -2; goto triangular_error; @@ -2958,49 +3110,55 @@ retval (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - Complex tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + Complex tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -3020,7 +3178,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -3040,47 +3199,52 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - Complex tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -3094,7 +3258,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -3111,7 +3278,8 @@ SparseComplexMatrix SparseComplexMatrix::ltsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3134,20 +3302,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += std::abs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -3179,7 +3350,7 @@ mini = i; } - if (minr != k) + if (minr != k || data (mini) == 0.) { err = -2; goto triangular_error; @@ -3224,49 +3395,55 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - Complex tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + Complex tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -3284,7 +3461,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -3326,47 +3504,52 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - Complex tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + Complex tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += std::abs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += std::abs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", @@ -3380,7 +3563,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -3395,9 +3581,10 @@ } ComplexMatrix -SparseComplexMatrix::trisolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseComplexMatrix::trisolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -3408,6 +3595,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3526,7 +3716,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3544,8 +3737,9 @@ SparseComplexMatrix SparseComplexMatrix::trisolve (SparseType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3556,6 +3750,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3614,13 +3811,16 @@ ("unrecoverable error in zgttrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3629,11 +3829,12 @@ else { char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); + volatile octave_idx_type x_nz = b.nnz (); octave_idx_type b_nc = b.cols (); retval = SparseComplexMatrix (nr, b_nc, x_nz); retval.xcidx(0) = 0; volatile octave_idx_type ii = 0; + rcond = 1.0; OCTAVE_LOCAL_BUFFER (Complex, work, nr); @@ -3695,7 +3896,8 @@ ComplexMatrix SparseComplexMatrix::trisolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -3706,6 +3908,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3834,7 +4039,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3849,8 +4057,10 @@ SparseComplexMatrix SparseComplexMatrix::trisolve (SparseType &mattype, - const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + const SparseComplexMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3861,6 +4071,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3919,13 +4132,16 @@ ("unrecoverable error in zgttrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3940,7 +4156,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); + volatile octave_idx_type x_nz = b.nnz (); volatile octave_idx_type ii = 0; retval = SparseComplexMatrix (b_nr, b_nc, x_nz); @@ -4010,9 +4226,10 @@ } ComplexMatrix -SparseComplexMatrix::bsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseComplexMatrix::bsolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4054,7 +4271,9 @@ } // Calculate the norm of the matrix, for later use. - // double anorm = m_band.abs().sum().row(0).max(); + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); char job = 'L'; F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), @@ -4066,9 +4285,9 @@ ("unrecoverable error in zpbtrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); @@ -4077,68 +4296,69 @@ } else { - // Unfortunately, the time to calculate the condition - // number is dominant for narrow banded matrices and - // so we rely on the "err" flag from xPBTRF to flag - // singularity. The commented code below is left here - // for reference - - //Array<double> z (3 * nr); - //Complex *pz = z.fortran_vec (); - //Array<octave_idx_type> iz (nr); - //octave_idx_type *piz = iz.fortran_vec (); - // - //F77_XFCN (zpbcon, ZGBCON, - // (F77_CONST_CHAR_ARG2 (&job, 1), - // nr, n_lower, tmp_data, ldm, - // anorm, rcond, pz, piz, err - // F77_CHAR_ARG_LEN (1))); - // - // - //if (f77_exception_encountered) - // (*current_liboctave_error_handler) - // ("unrecoverable error in zpbcon"); - // - //if (err != 0) - // err = -2; - // - //volatile double rcond_plus_one = rcond + 1.0; - // - //if (rcond_plus_one == 1.0 || xisnan (rcond)) - // { - // err = -2; - // - // if (sing_handler) - // sing_handler (rcond); - // else - // (*current_liboctave_error_handler) - // ("matrix singular to machine precision, rcond = %g", - // rcond); - // } - //else - // REST OF CODE, EXCEPT rcond=1 - - rcond = 1.; - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (zpbtrs, ZPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, b_nc, tmp_data, - ldm, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zpbcon, ZPBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.0; + + if (err == 0) + { + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (zpbtrs, ZPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, b_nc, tmp_data, + ldm, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zpbtrs"); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpbtrs"); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + } } } } @@ -4167,6 +4387,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4180,73 +4414,81 @@ { // Throw-away extra info LAPACK gives so as to not // change output. - rcond = 0.0; if (err != 0) { + rcond = 0.0; err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); - } else { - char job = '1'; - - // Unfortunately, the time to calculate the condition - // number is dominant for narrow banded matrices and - // so we rely on the "err" flag from xPBTRF to flag - // singularity. The commented code below is left here - // for reference - - //F77_XFCN (zgbcon, ZGBCON, - // (F77_CONST_CHAR_ARG2 (&job, 1), - // nc, n_lower, n_upper, tmp_data, ldm, pipvt, - // anorm, rcond, pz, piz, err - // F77_CHAR_ARG_LEN (1))); - // - //if (f77_exception_encountered) - // (*current_liboctave_error_handler) - // ("unrecoverable error in zgbcon"); - // - // if (err != 0) - // err = -2; - // - //volatile double rcond_plus_one = rcond + 1.0; - // - //if (rcond_plus_one == 1.0 || xisnan (rcond)) - // { - // err = -2; - // - // if (sing_handler) - // sing_handler (rcond); - // else - // (*current_liboctave_error_handler) - // ("matrix singular to machine precision, rcond = %g", - // rcond); - // } - //else - // REST OF CODE, EXCEPT rcond=1 - - rcond = 1.; - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - job = 'N'; - F77_XFCN (zgbtrs, ZGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, b_nc, tmp_data, - ldm, pipvt, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + char job = '1'; + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zgbcon, ZGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (zgbtrs, ZGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, b_nc, tmp_data, + ldm, pipvt, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgbtrs"); + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgbtrs"); + } } } } @@ -4260,7 +4502,8 @@ SparseComplexMatrix SparseComplexMatrix::bsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -4302,6 +4545,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4312,75 +4560,118 @@ ("unrecoverable error in zpbtrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; mattype.mark_as_unsymmetric (); typ = SparseType::Banded; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); - volatile octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) + { + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zpbcon, ZPBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.0; + + if (err == 0) { - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b.elem (i, j); - - F77_XFCN (zpbtrs, ZPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b.elem (i, j); + + F77_XFCN (zpbtrs, ZPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + err = -1; + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex tmp = Bx[i]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * + (b_nc - j) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + retval.xdata(ii) = tmp; + retval.xridx(ii++) = i; + } + } + retval.xcidx(j+1) = ii; } - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - err = -1; - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex tmp = Bx[i]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - j) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - retval.xdata(ii) = tmp; - retval.xridx(ii++) = i; - } - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4408,6 +4699,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4419,13 +4724,16 @@ ("unrecoverable error in zgbtrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; err = -2; if (sing_handler) + { sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4433,60 +4741,105 @@ } else { - char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); - octave_idx_type b_nc = b.cols (); - retval = SparseComplexMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (Complex, work, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - work[b.ridx(i)] = b.data(i); - - F77_XFCN (zgbtrs, ZGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, work, b.rows (), err - F77_CHAR_ARG_LEN (1))); - + char job = '1'; + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zgbcon, ZGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseComplexMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (Complex, work, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - (*current_liboctave_error_handler) - ("unrecoverable error in zgbtrs"); - break; + for (octave_idx_type i = 0; i < nr; i++) + work[i] = 0.; + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + work[b.ridx(i)] = b.data(i); + + F77_XFCN (zgbtrs, ZGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, work, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in zgbtrs"); + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (work[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; } - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (work[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4500,7 +4853,8 @@ ComplexMatrix SparseComplexMatrix::bsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4542,6 +4896,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4552,41 +4911,83 @@ ("unrecoverable error in zpbtrf"); else { - rcond = 0.0; if (err != 0) { // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. + rcond = 0.0; mattype.mark_as_unsymmetric (); typ = SparseType::Banded; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zpbtrs, ZPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, b_nc, tmp_data, - ldm, result, b_nr, err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zpbcon, ZPBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.0; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zpbtrs, ZPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, b_nc, tmp_data, + ldm, result, b_nr, err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in zpbtrs"); - err = -1; - } - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - err = -1; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in zpbtrs"); + err = -1; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + err = -1; + } } } } @@ -4615,6 +5016,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4626,35 +5041,81 @@ ("unrecoverable error in zgbtrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); - } else { - char job = 'N'; - octave_idx_type b_nc = b.cols (); - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zgbtrs, ZGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, b_nc, tmp_data, - ldm, pipvt, result, b.rows (), err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + char job = '1'; + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zgbcon, ZGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + octave_idx_type b_nc = b.cols (); + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zgbtrs, ZGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, b_nc, tmp_data, + ldm, pipvt, result, b.rows (), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + } } } } @@ -4668,8 +5129,9 @@ SparseComplexMatrix SparseComplexMatrix::bsolve (SparseType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -4711,6 +5173,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4721,7 +5188,6 @@ ("unrecoverable error in zpbtrf"); else { - rcond = 0.0; if (err != 0) { // Matrix is not positive definite!! Fall through to @@ -4729,77 +5195,119 @@ mattype.mark_as_unsymmetric (); typ = SparseType::Banded; + rcond = 0.0; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); - volatile octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b (i,j); - - F77_XFCN (zpbtrs, ZPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); - + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zpbcon, ZPBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in zpbtrs"); - err = -1; - break; - } - - if (err != 0) + (*current_liboctave_error_handler) + ("unrecoverable error in zpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.0; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0.) - new_nnz++; + + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b (i,j); + + F77_XFCN (zpbtrs, ZPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in zpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0.) + new_nnz++; - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = Bx[i]; - } - - retval.xcidx(j+1) = ii; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = Bx[i]; + } + + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4827,6 +5335,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += std::abs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4838,13 +5360,16 @@ ("unrecoverable error in xgbtrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4852,61 +5377,106 @@ } else { - char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); - octave_idx_type b_nc = b.cols (); - retval = SparseComplexMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (Complex, Bx, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - for (octave_idx_type i = 0; i < nr; i++) - Bx[i] = 0.; - - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - Bx[b.ridx(i)] = b.data(i); - - F77_XFCN (zgbtrs, ZGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bx, b.rows (), err - F77_CHAR_ARG_LEN (1))); - + char job = '1'; + Array<Complex> z (2 * nr); + Complex *pz = z.fortran_vec (); + Array<double> iz (nr); + double *piz = iz.fortran_vec (); + + F77_XFCN (zgbcon, ZGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseComplexMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (Complex, Bx, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; + for (octave_idx_type i = 0; i < nr; i++) + Bx[i] = 0.; + + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + Bx[b.ridx(i)] = b.data(i); + + F77_XFCN (zgbtrs, ZGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bx, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = Bx[i]; + } + retval.xcidx(j+1) = ii; } - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = Bx[i]; - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4918,9 +5488,10 @@ } void * -SparseComplexMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, - Matrix &Info, - solve_singularity_handler sing_handler) const +SparseComplexMatrix::factorize (octave_idx_type& err, double &rcond, + Matrix &Control, Matrix &Info, + solve_singularity_handler sing_handler, + bool calc_cond) const { // The return values void *Numeric = 0; @@ -4985,7 +5556,10 @@ Symbolic, &Numeric, control, info) ; UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; - rcond = Info (UMFPACK_RCOND); + if (calc_cond) + rcond = Info (UMFPACK_RCOND); + else + rcond = 1.; volatile double rcond_plus_one = rcond + 1.0; if (status == UMFPACK_WARNING_singular_matrix || @@ -5029,9 +5603,10 @@ } ComplexMatrix -SparseComplexMatrix::fsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseComplexMatrix::fsolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -5139,7 +5714,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5157,7 +5735,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5200,7 +5781,7 @@ #ifdef HAVE_UMFPACK Matrix Control, Info; void *Numeric = factorize (err, rcond, Control, Info, - sing_handler); + sing_handler, calc_cond); if (err == 0) { @@ -5264,6 +5845,9 @@ UMFPACK_ZNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5278,7 +5862,8 @@ SparseComplexMatrix SparseComplexMatrix::fsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -5397,7 +5982,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5415,7 +6003,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5463,7 +6054,8 @@ { #ifdef HAVE_UMFPACK Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, sing_handler); + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); if (err == 0) { @@ -5487,7 +6079,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - octave_idx_type x_nz = b.nzmax (); + octave_idx_type x_nz = b.nnz (); octave_idx_type ii = 0; retval = SparseComplexMatrix (b_nr, b_nc, x_nz); @@ -5557,6 +6149,9 @@ UMFPACK_ZNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5571,7 +6166,8 @@ ComplexMatrix SparseComplexMatrix::fsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -5680,7 +6276,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5698,7 +6297,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5740,7 +6342,8 @@ { #ifdef HAVE_UMFPACK Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, sing_handler); + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); if (err == 0) { @@ -5783,6 +6386,9 @@ UMFPACK_ZNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5797,7 +6403,8 @@ SparseComplexMatrix SparseComplexMatrix::fsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -5916,7 +6523,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5934,7 +6544,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5982,7 +6595,8 @@ { #ifdef HAVE_UMFPACK Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, sing_handler); + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); if (err == 0) { @@ -5999,7 +6613,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - octave_idx_type x_nz = b.nzmax (); + octave_idx_type x_nz = b.nnz (); octave_idx_type ii = 0; retval = SparseComplexMatrix (b_nr, b_nc, x_nz); @@ -6072,6 +6686,9 @@ UMFPACK_ZNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -6111,30 +6728,43 @@ double& rcond, solve_singularity_handler sing_handler) const { + ComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<ComplexMatrix, SparseComplexMatrix, + Matrix> (*this, b, err); +#endif + } + + return retval; } SparseComplexMatrix @@ -6165,30 +6795,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + SparseComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, + SparseMatrix> (*this, b, err); +#endif + } + + return retval; } ComplexMatrix @@ -6219,30 +6862,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + ComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<ComplexMatrix, SparseComplexMatrix, + ComplexMatrix> (*this, b, err); +#endif + } + + return retval; } SparseComplexMatrix @@ -6274,30 +6930,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + SparseComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, + SparseComplexMatrix> (*this, b, err); +#endif + } + + return retval; } ComplexColumnVector @@ -6543,145 +7212,13 @@ return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); } -ComplexMatrix -SparseComplexMatrix::lssolve (const Matrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info, octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseMatrix& b, octave_idx_type& info, - octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -ComplexMatrix -SparseComplexMatrix::lssolve (const ComplexMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseComplexMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseComplexMatrix::lssolve (const SparseComplexMatrix& b, octave_idx_type& info, - octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ColumnVector& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, octave_idx_type& rank) const -{ - Matrix tmp (b); - return lssolve (tmp, info, rank).column (static_cast<octave_idx_type> (0)); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ComplexColumnVector& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const -{ - ComplexMatrix tmp (b); - return lssolve (tmp, info, rank).column (static_cast<octave_idx_type> (0)); -} - // unary operations SparseBoolMatrix SparseComplexMatrix::operator ! (void) const { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz1 = nzmax (); + octave_idx_type nz1 = nnz (); octave_idx_type nz2 = nr*nc - nz1; SparseBoolMatrix r (nr, nc, nz2); @@ -6755,7 +7292,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); bool f_zero = (f(0.0) == 0.0); // Count number of non-zero elements @@ -6805,7 +7342,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); bool f_zero = (f(0.0) == 0.0); // Count number of non-zero elements @@ -6855,7 +7392,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); bool f_zero = f(0.0); // Count number of non-zero elements @@ -6910,7 +7447,7 @@ bool SparseComplexMatrix::any_element_is_inf_or_nan (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -6927,7 +7464,7 @@ bool SparseComplexMatrix::all_elements_are_real (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -6947,7 +7484,7 @@ bool SparseComplexMatrix::all_integers (double& max_val, double& min_val) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); if (nel == 0) return false; @@ -6984,7 +7521,7 @@ bool SparseComplexMatrix::too_large_for_float (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -7062,7 +7599,7 @@ SparseMatrix SparseComplexMatrix::abs (void) const { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type nc = cols (); SparseMatrix retval (rows(), nc, nz); @@ -7237,74 +7774,55 @@ SparseComplexMatrix operator * (const SparseComplexMatrix& m, const SparseMatrix& a) { - SparseComplexMatrix tmp (a); - return m * tmp; + SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, double); } SparseComplexMatrix operator * (const SparseMatrix& m, const SparseComplexMatrix& a) { - SparseComplexMatrix tmp (m); - return tmp * a; + SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, Complex); } SparseComplexMatrix operator * (const SparseComplexMatrix& m, const SparseComplexMatrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? -#else - // Use Andy's sparse matrix multiply function - SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex); -#endif + SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, Complex); } ComplexMatrix operator * (const ComplexMatrix& m, const SparseMatrix& a) { - SparseComplexMatrix tmp (a); - return m * tmp; + FULL_SPARSE_MUL (ComplexMatrix, double, Complex (0.,0.)); } ComplexMatrix operator * (const Matrix& m, const SparseComplexMatrix& a) { - ComplexMatrix tmp (m); - return tmp * a; + FULL_SPARSE_MUL (ComplexMatrix, Complex, Complex (0.,0.)); } ComplexMatrix operator * (const ComplexMatrix& m, const SparseComplexMatrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? -#else - FULL_SPARSE_MUL (ComplexMatrix, Complex); -#endif + FULL_SPARSE_MUL (ComplexMatrix, Complex, Complex (0.,0.)); } ComplexMatrix operator * (const SparseComplexMatrix& m, const Matrix& a) { - ComplexMatrix tmp (a); - return m * tmp; + SPARSE_FULL_MUL (ComplexMatrix, double, Complex (0.,0.)); } ComplexMatrix operator * (const SparseMatrix& m, const ComplexMatrix& a) { - SparseComplexMatrix tmp (m); - return tmp * a; + SPARSE_FULL_MUL (ComplexMatrix, Complex, Complex (0.,0.)); } ComplexMatrix operator * (const SparseComplexMatrix& m, const ComplexMatrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? -#else - SPARSE_FULL_MUL (ComplexMatrix, Complex); -#endif + SPARSE_FULL_MUL (ComplexMatrix, Complex, Complex (0.,0.)); } // XXX FIXME XXX -- it would be nice to share code among the min/max @@ -7357,14 +7875,14 @@ octave_idx_type b_nr = b.rows (); octave_idx_type b_nc = b.cols (); - if (a_nr == 0 || b_nc == 0 || a.nzmax () == 0 || b.nzmax () == 0) + if (a_nr == 0 || b_nc == 0 || a.nnz () == 0 || b.nnz () == 0) return SparseComplexMatrix (a_nr, a_nc); if (a_nr != b_nr || a_nc != b_nc) gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else { - r = SparseComplexMatrix (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; r.cidx (0) = 0; @@ -7479,16 +7997,16 @@ if (a_nr == 0 || b_nc == 0) return SparseComplexMatrix (a_nr, a_nc); - if (a.nzmax () == 0) + if (a.nnz () == 0) return SparseComplexMatrix (b); - if (b.nzmax () == 0) + if (b.nnz () == 0) return SparseComplexMatrix (a); if (a_nr != b_nr || a_nc != b_nc) gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else { - r = SparseComplexMatrix (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; r.cidx (0) = 0;
--- a/liboctave/CSparse.h Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/CSparse.h Thu Mar 16 17:48:56 2006 +0000 @@ -146,90 +146,129 @@ private: // Diagonal matrix solvers ComplexMatrix dsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix dsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix dsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix dsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Upper triangular matrix solvers ComplexMatrix utsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix utsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix utsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix utsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Lower triangular matrix solvers - ComplexMatrix ltsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix ltsolve (SparseType &typ, const Matrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix ltsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix ltsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix ltsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Tridiagonal matrix solvers - ComplexMatrix trisolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix trisolve (SparseType &typ, const Matrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix trisolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix trisolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix trisolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Banded matrix solvers (umfpack/cholesky) ComplexMatrix bsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix bsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix bsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix bsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Full matrix solvers (umfpack/cholesky) - void * factorize (octave_idx_type& err, double &rcond, Matrix &Control, Matrix &Info, - solve_singularity_handler sing_handler) const; + void * factorize (octave_idx_type& err, double &rcond, Matrix &Control, + Matrix &Info, solve_singularity_handler sing_handler, + bool calc_cond) const; ComplexMatrix fsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseComplexMatrix fsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseComplexMatrix fsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix fsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; public: // Generic interface to solver with no probing of type @@ -328,36 +367,6 @@ double& rcond, solve_singularity_handler sing_handler) const; - ComplexMatrix lssolve (const Matrix& b) const; - ComplexMatrix lssolve (const Matrix& b, octave_idx_type& info) const; - ComplexMatrix lssolve (const Matrix& b, octave_idx_type& info, octave_idx_type& rank) const; - - ComplexMatrix lssolve (const ComplexMatrix& b) const; - ComplexMatrix lssolve (const ComplexMatrix& b, octave_idx_type& info) const; - ComplexMatrix lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const; - - SparseComplexMatrix lssolve (const SparseMatrix& b) const; - SparseComplexMatrix lssolve (const SparseMatrix& b, octave_idx_type& info) const; - SparseComplexMatrix lssolve (const SparseMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const; - - SparseComplexMatrix lssolve (const SparseComplexMatrix& b) const; - SparseComplexMatrix lssolve (const SparseComplexMatrix& b, - octave_idx_type& info) const; - SparseComplexMatrix lssolve (const SparseComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const; - - ComplexColumnVector lssolve (const ColumnVector& b) const; - ComplexColumnVector lssolve (const ColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector lssolve (const ColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const; - - ComplexColumnVector lssolve (const ComplexColumnVector& b) const; - ComplexColumnVector lssolve (const ComplexColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const; - SparseComplexMatrix squeeze (void) const; SparseComplexMatrix index (idx_vector& i, int resize_ok) const;
--- a/liboctave/ChangeLog Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/ChangeLog Thu Mar 16 17:48:56 2006 +0000 @@ -1,3 +1,53 @@ +2006-03-16 David Bateman <dbateman@free.fr> + + * CSparse.cc: Change use of nzmax to nnz to allow automatic + reduction of matrix size, except for a couple of cases where nzmax + is needed. + (zpbcon): Correct declaration of lapack zpbcon function. + (dsolve, utsolve, ltsolve, trisolve, bsolve, factorize, fsolve): Add + an argument to allow the calculation of condition number to be + optional. + (bsolve): Add code for the calculation of the condition number + using zpbcon and zgbcon. + (dsolve): Bug fix for rectangular matrices with sparse RHS. + (utsolve, ltsolve, trisolve, bsolve, fsolve): Mark matrix type as + singular if singularity is detected. + (solve): Use optional argument to disable calculation of + condition number for all but fsolve, for speed. Add code to + allow rectnagular matrices or matrices identified as singular + to be treated. + (lssolve): delete. + (operator *): Don't recast real matrices as complex, but + rather use the macro directly on the real data. + * dSparse.cc: ditto. + * CSparse.h (dsolve, utsolve, ltsolve, trisolve, bsolve, + fsolve, factorize): Update declaration for new argument to + calculate the condition number. + (lssolve): delete. + * dSparse.h: ditto. + * Msparse.h: Change use of nxmax to nnz to allow automatic + reduction of matrix size, except for a couple of cases where + nzmax is needed. + * Sparse.cc: Change use of nxmax to nnz to allow automatic + reduction of matrix size, except for a couple of cases where + nzmax is needed. + (Sparse<T>::index (idx_vector&, idx_vector&, int) const): + Special case strict permutations for speed. + * Sparse-op-defs.h: Change use of nxmax to nnz to allow automatic + reduction of matrix size, except for a couple of cases where + nzmax is needed. + (SPARSE_SPARSE_MUL, SPARSE_FULL_MUL, FULL_SPARSE_MUL): Update + macros to allow mixed complex/real arguments. + * SparseCmplxQR.cc (OCTAVE_C99_ZERO): New macro for C99 zero + value. + (qrsolve): Use it to zero temporary buffers used bt CXSPARSE. + * SparseType.cc (SparseType::SparseType ()): Correct detection + of permutated triangular matrices to avoid seg-faults. Disable + detection of underdetermined lower and over-determined upper + matrix due to problems with non minimum norm solutions. + * sparse-dmsolve.cc: New file for Dulmage-Mendelsohn solver. + * Makefile.in: add sparse-dmsolve.cc to targets. + 2006-03-15 William Poetra Yoga Hadisoeseno <williampoetra@gmail.com> * oct-time.cc (octave_strptime::init): Return useful character count.
--- a/liboctave/MSparse.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/MSparse.cc Thu Mar 16 17:48:56 2006 +0000 @@ -52,7 +52,7 @@ gripe_nonconformant ("operator +=" , a_nr, a_nc, b_nr, b_nc); else { - r = MSparse<T> (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; for (octave_idx_type i = 0 ; i < a_nc ; i++) @@ -125,7 +125,7 @@ gripe_nonconformant ("operator -=" , a_nr, a_nc, b_nr, b_nc); else { - r = MSparse<T> (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; for (octave_idx_type i = 0 ; i < a_nc ; i++) @@ -207,7 +207,7 @@ { \ octave_idx_type nr = a.rows (); \ octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nzmax (); \ + octave_idx_type nz = a.nnz (); \ \ MSparse<T> r (nr, nc, nz); \ \ @@ -253,7 +253,7 @@ { \ octave_idx_type nr = a.rows (); \ octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nzmax (); \ + octave_idx_type nz = a.nnz (); \ \ MSparse<T> r (nr, nc, nz); \ \ @@ -292,7 +292,7 @@ gripe_nonconformant ("operator " # OP, a_nr, a_nc, b_nr, b_nc); \ else \ { \ - r = MSparse<T> (a_nr, a_nc, (a.nzmax () + b.nzmax ())); \ + r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); \ \ octave_idx_type jx = 0; \ r.cidx (0) = 0; \ @@ -367,7 +367,7 @@ gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \ else \ { \ - r = MSparse<T> (a_nr, a_nc, (a.nzmax () > b.nzmax () ? a.nzmax () : b.nzmax ())); \ + r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); \ \ octave_idx_type jx = 0; \ r.cidx (0) = 0; \ @@ -494,7 +494,7 @@ operator - (const MSparse<T>& a) { MSparse<T> retval (a); - octave_idx_type nz = a.nzmax (); + octave_idx_type nz = a.nnz (); for (octave_idx_type i = 0; i < nz; i++) retval.data(i) = - retval.data(i); return retval;
--- a/liboctave/Makefile.in Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/Makefile.in Thu Mar 16 17:48:56 2006 +0000 @@ -37,8 +37,9 @@ dbleHESS.h dbleLU.h dbleQR.h dbleQRP.h dbleSCHUR.h dbleSVD.h \ boolSparse.h CSparse.h dSparse.h MSparse-defs.h MSparse.h \ Sparse.h sparse-base-lu.h SparseCmplxLU.h SparsedbleLU.h \ - sparse-base-chol.h SparseCmplxCHOL.h SparsedbleCHOL.h \ - SparseCmplxQR.h SparseQR.h Sparse-op-defs.h SparseType.h \ + sparse-base-chol.h sparse-dmsolve.cc SparseCmplxCHOL.h \ + SparsedbleCHOL.h SparseCmplxQR.h SparseQR.h Sparse-op-defs.h \ + SparseType.h \ int8NDArray.h uint8NDArray.h int16NDArray.h uint16NDArray.h \ int32NDArray.h uint32NDArray.h int64NDArray.h uint64NDArray.h \ intNDArray.h @@ -79,7 +80,8 @@ TEMPLATE_SRC := Array.cc ArrayN.cc DiagArray2.cc \ MArray.cc MArray2.cc MArrayN.cc MDiagArray2.cc \ - base-lu.cc oct-sort.cc sparse-base-lu.cc sparse-base-chol.cc + base-lu.cc oct-sort.cc sparse-base-lu.cc sparse-base-chol.cc \ + sparse-dmsolve.cc TI_SRC := Array-C.cc Array-b.cc Array-ch.cc Array-i.cc Array-d.cc \ Array-s.cc Array-so.cc Array-str.cc Array-idx-vec.cc \
--- a/liboctave/Sparse-op-defs.h Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/Sparse-op-defs.h Thu Mar 16 17:48:56 2006 +0000 @@ -63,7 +63,7 @@ { \ octave_idx_type nr = m.rows (); \ octave_idx_type nc = m.cols (); \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ \ R r (nr, nc, nz); \ \ @@ -103,7 +103,7 @@ { \ /* Count num of non-zero elements */ \ octave_idx_type nel = 0; \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ if (MC (MZ) OP SC (s)) \ nel += m.numel() - nz; \ for (octave_idx_type i = 0; i < nz; i++) \ @@ -178,7 +178,7 @@ { \ /* Count num of non-zero elements */ \ octave_idx_type nel = 0; \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ if (LHS_ZERO OP (s != RHS_ZERO)) \ nel += m.numel() - nz; \ for (octave_idx_type i = 0; i < nz; i++) \ @@ -273,7 +273,7 @@ { \ octave_idx_type nr = m.rows (); \ octave_idx_type nc = m.cols (); \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ \ R r (nr, nc, nz); \ \ @@ -313,7 +313,7 @@ { \ /* Count num of non-zero elements */ \ octave_idx_type nel = 0; \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ if (SC (s) OP MC (MZ)) \ nel += m.numel() - nz; \ for (octave_idx_type i = 0; i < nz; i++) \ @@ -388,7 +388,7 @@ { \ /* Count num of non-zero elements */ \ octave_idx_type nel = 0; \ - octave_idx_type nz = m.nzmax (); \ + octave_idx_type nz = m.nnz (); \ if ((s != LHS_ZERO) OP RHS_ZERO) \ nel += m.numel() - nz; \ for (octave_idx_type i = 0; i < nz; i++) \ @@ -477,7 +477,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - r = R (m1_nr, m1_nc, (m1.nzmax () + m2.nzmax ())); \ + r = R (m1_nr, m1_nc, (m1.nnz () + m2.nnz ())); \ \ octave_idx_type jx = 0; \ r.cidx (0) = 0; \ @@ -551,7 +551,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - r = R (m1_nr, m1_nc, (m1.nzmax () > m2.nzmax () ? m1.nzmax () : m2.nzmax ())); \ + r = R (m1_nr, m1_nc, (m1.nnz () > m2.nnz () ? m1.nnz () : m2.nnz ())); \ \ octave_idx_type jx = 0; \ r.cidx (0) = 0; \ @@ -1533,7 +1533,7 @@ #define SPARSE_ANY_OP(DIM) SPARSE_ANY_ALL_OP (DIM, false, !=, true) -#define SPARSE_SPARSE_MUL( RET_TYPE, EL_TYPE ) \ +#define SPARSE_SPARSE_MUL( RET_TYPE, RET_EL_TYPE, EL_TYPE ) \ octave_idx_type nr = m.rows (); \ octave_idx_type nc = m.cols (); \ \ @@ -1577,7 +1577,7 @@ for (octave_idx_type i = 0; i < nr; i++) \ w[i] = 0; \ \ - OCTAVE_LOCAL_BUFFER (EL_TYPE, Xcol, nr); \ + OCTAVE_LOCAL_BUFFER (RET_EL_TYPE, Xcol, nr); \ \ RET_TYPE retval (nr, a_nc, nel); \ octave_idx_type ii = 0; \ @@ -1663,7 +1663,7 @@ } \ } -#define SPARSE_FULL_MUL( RET_TYPE, EL_TYPE ) \ +#define SPARSE_FULL_MUL( RET_TYPE, EL_TYPE, ZERO ) \ octave_idx_type nr = m.rows (); \ octave_idx_type nc = m.cols (); \ \ @@ -1677,7 +1677,7 @@ } \ else \ { \ - RET_TYPE retval (nr, a_nc, EL_TYPE ()); \ + RET_TYPE retval (nr, a_nc, ZERO); \ \ for (octave_idx_type i = 0; i < a_nc ; i++) \ { \ @@ -1693,7 +1693,7 @@ return retval; \ } -#define FULL_SPARSE_MUL( RET_TYPE, EL_TYPE ) \ +#define FULL_SPARSE_MUL( RET_TYPE, EL_TYPE, ZERO ) \ octave_idx_type nr = m.rows (); \ octave_idx_type nc = m.cols (); \ \ @@ -1707,7 +1707,7 @@ } \ else \ { \ - RET_TYPE retval (nr, a_nc, EL_TYPE ()); \ + RET_TYPE retval (nr, a_nc, ZERO); \ \ for (octave_idx_type i = 0; i < a_nc ; i++) \ { \
--- a/liboctave/Sparse.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/Sparse.cc Thu Mar 16 17:48:56 2006 +0000 @@ -202,13 +202,13 @@ Sparse<T>::Sparse (const Sparse<U>& a) : dimensions (a.dimensions), idx (0), idx_count (0) { - if (a.nzmax () == 0) + if (a.nnz () == 0) rep = new typename Sparse<T>::SparseRep (rows (), cols()); else { - rep = new typename Sparse<T>::SparseRep (rows (), cols (), a.nzmax ()); + rep = new typename Sparse<T>::SparseRep (rows (), cols (), a.nnz ()); - octave_idx_type nz = nzmax (); + octave_idx_type nz = a.nnz (); octave_idx_type nc = cols (); for (octave_idx_type i = 0; i < nz; i++) { @@ -276,7 +276,7 @@ else { dim_vector old_dims = a.dims(); - octave_idx_type new_nzmx = a.nzmax (); + octave_idx_type new_nzmx = a.nnz (); octave_idx_type new_nr = dv (0); octave_idx_type new_nc = dv (1); octave_idx_type old_nr = old_dims (0); @@ -740,12 +740,12 @@ { if (dimensions.numel () == new_dims.numel ()) { - octave_idx_type new_nzmx = nzmax (); + octave_idx_type new_nnz = nnz (); octave_idx_type new_nr = new_dims (0); octave_idx_type new_nc = new_dims (1); octave_idx_type old_nr = rows (); octave_idx_type old_nc = cols (); - retval = Sparse<T> (new_nr, new_nc, new_nzmx); + retval = Sparse<T> (new_nr, new_nc, new_nnz); octave_idx_type kk = 0; retval.xcidx(0) = 0; @@ -762,7 +762,7 @@ retval.xridx(j) = ii; } for (octave_idx_type k = kk; k < new_nc; k++) - retval.xcidx(k+1) = new_nzmx; + retval.xcidx(k+1) = new_nnz; } else (*current_liboctave_error_handler) ("reshape: size mismatch"); @@ -855,7 +855,7 @@ octave_idx_type nc = cols (); octave_idx_type nr = rows (); - if (nzmax () == 0 || r == 0 || c == 0) + if (nnz () == 0 || r == 0 || c == 0) // Special case of redimensioning to/from a sparse matrix with // no elements rep = new typename Sparse<T>::SparseRep (r, c); @@ -944,7 +944,7 @@ } // First count the number of elements in the final array - octave_idx_type nel = cidx(c) + a.nzmax (); + octave_idx_type nel = cidx(c) + a.nnz (); if (c + a_cols < nc) nel += cidx(nc) - cidx(c + a_cols); @@ -1142,7 +1142,7 @@ if (num_to_delete != 0) { octave_idx_type new_n = n; - octave_idx_type new_nzmx = nzmax (); + octave_idx_type new_nnz = nnz (); octave_idx_type iidx = 0; @@ -1158,7 +1158,7 @@ new_n--; if (tmp.elem (i) != T ()) - new_nzmx--; + new_nnz--; if (iidx == num_to_delete) break; @@ -1170,9 +1170,9 @@ rep->count--; if (nr == 1) - rep = new typename Sparse<T>::SparseRep (1, new_n, new_nzmx); + rep = new typename Sparse<T>::SparseRep (1, new_n, new_nnz); else - rep = new typename Sparse<T>::SparseRep (new_n, 1, new_nzmx); + rep = new typename Sparse<T>::SparseRep (new_n, 1, new_nnz); octave_idx_type ii = 0; octave_idx_type jj = 0; @@ -1215,7 +1215,7 @@ else { cidx(0) = 0; - cidx(1) = new_nzmx; + cidx(1) = new_nnz; dimensions(0) = new_n; dimensions(1) = 1; } @@ -1287,7 +1287,7 @@ else { octave_idx_type new_nc = nc; - octave_idx_type new_nzmx = nzmax (); + octave_idx_type new_nnz = nnz (); octave_idx_type iidx = 0; @@ -1300,7 +1300,7 @@ iidx++; new_nc--; - new_nzmx -= cidx(j+1) - cidx(j); + new_nnz -= cidx(j+1) - cidx(j); if (iidx == num_to_delete) break; @@ -1312,7 +1312,7 @@ const Sparse<T> tmp (*this); --rep->count; rep = new typename Sparse<T>::SparseRep (nr, new_nc, - new_nzmx); + new_nnz); octave_idx_type ii = 0; octave_idx_type jj = 0; iidx = 0; @@ -1362,7 +1362,7 @@ else { octave_idx_type new_nr = nr; - octave_idx_type new_nzmx = nzmax (); + octave_idx_type new_nnz = nnz (); octave_idx_type iidx = 0; @@ -1375,9 +1375,9 @@ iidx++; new_nr--; - for (octave_idx_type j = 0; j < nzmax (); j++) + for (octave_idx_type j = 0; j < nnz (); j++) if (ridx(j) == i) - new_nzmx--; + new_nnz--; if (iidx == num_to_delete) break; @@ -1389,7 +1389,7 @@ const Sparse<T> tmp (*this); --rep->count; rep = new typename Sparse<T>::SparseRep (new_nr, nc, - new_nzmx); + new_nnz); octave_idx_type jj = 0; cidx(0) = 0; @@ -1483,7 +1483,7 @@ octave_idx_type nr = dim1 (); octave_idx_type nc = dim2 (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type orig_len = nr * nc; @@ -1838,66 +1838,151 @@ { retval.resize_no_fill (n, m); } - else if (idx_i.is_colon_equiv (nr) && idx_j.is_colon_equiv (nc)) - { - retval = *this; - } - else + else { - // First count the number of non-zero elements - octave_idx_type new_nzmx = 0; - for (octave_idx_type j = 0; j < m; j++) + int idx_i_colon = idx_i.is_colon_equiv (nr); + int idx_j_colon = idx_j.is_colon_equiv (nc); + + if (idx_i_colon && idx_j_colon) + { + retval = *this; + } + else { - octave_idx_type jj = idx_j.elem (j); - for (octave_idx_type i = 0; i < n; i++) + // Identify if the indices have any repeated values + bool permutation = true; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, itmp, + (nr > nc ? nr : nc)); + octave_sort<octave_idx_type> sort; + + if (n > nr || m > nc) + permutation = false; + + if (permutation && ! idx_i_colon) + { + // Can't use something like + // idx_vector tmp_idx = idx_i; + // tmp_idx.sort (true); + // if (tmp_idx.length(nr) != n) + // permutation = false; + // here as there is no make_unique function + // for idx_vector type. + for (octave_idx_type i = 0; i < n; i++) + itmp [i] = idx_i.elem (i); + sort.sort (itmp, n); + for (octave_idx_type i = 1; i < n; i++) + if (itmp[i-1] == itmp[i]) + { + permutation = false; + break; + } + } + if (permutation && ! idx_j_colon) + { + for (octave_idx_type i = 0; i < m; i++) + itmp [i] = idx_j.elem (i); + sort.sort (itmp, m); + for (octave_idx_type i = 1; i < m; i++) + if (itmp[i-1] == itmp[i]) + { + permutation = false; + break; + } + } + + if (permutation) { - OCTAVE_QUIT; - - octave_idx_type ii = idx_i.elem (i); - if (ii < nr && jj < nc) + // Special case permutation like indexing for speed + retval = Sparse<T> (n, m, nnz ()); + octave_idx_type *ri = retval.xridx (); + + // Can't use OCTAVE_LOCAL_BUFFER with bool, and so + // can't with T either + T X [n]; + for (octave_idx_type i = 0; i < nr; i++) + itmp [i] = -1; + for (octave_idx_type i = 0; i < n; i++) + itmp[idx_i.elem(i)] = i; + + octave_idx_type kk = 0; + retval.xcidx(0) = 0; + for (octave_idx_type j = 0; j < m; j++) + { + octave_idx_type jj = idx_j.elem (j); + for (octave_idx_type i = cidx(jj); i < cidx(jj+1); i++) + { + octave_idx_type ii = itmp [ridx(i)]; + if (ii >= 0) + { + X [ii] = data (i); + retval.xridx (kk++) = ii; + } + } + sort.sort (ri + retval.xcidx (j), kk - retval.xcidx (j)); + for (octave_idx_type p = retval.xcidx (j); p < kk; p++) + retval.xdata (p) = X [retval.xridx (p)]; + retval.xcidx(j+1) = kk; + } + retval.maybe_compress (); + } + else + { + // First count the number of non-zero elements + octave_idx_type new_nzmx = 0; + for (octave_idx_type j = 0; j < m; j++) { - for (octave_idx_type k = cidx(jj); k < cidx(jj+1); k++) + octave_idx_type jj = idx_j.elem (j); + for (octave_idx_type i = 0; i < n; i++) { - if (ridx(k) == ii) - new_nzmx++; - if (ridx(k) >= ii) - break; + OCTAVE_QUIT; + + octave_idx_type ii = idx_i.elem (i); + if (ii < nr && jj < nc) + { + for (octave_idx_type k = cidx(jj); k < cidx(jj+1); k++) + { + if (ridx(k) == ii) + new_nzmx++; + if (ridx(k) >= ii) + break; + } + } } } + + retval = Sparse<T> (n, m, new_nzmx); + + octave_idx_type kk = 0; + retval.xcidx(0) = 0; + for (octave_idx_type j = 0; j < m; j++) + { + octave_idx_type jj = idx_j.elem (j); + for (octave_idx_type i = 0; i < n; i++) + { + OCTAVE_QUIT; + + octave_idx_type ii = idx_i.elem (i); + if (ii < nr && jj < nc) + { + for (octave_idx_type k = cidx(jj); k < cidx(jj+1); k++) + { + if (ridx(k) == ii) + { + retval.xdata(kk) = data(k); + retval.xridx(kk++) = i; + } + if (ridx(k) >= ii) + break; + } + } + } + retval.xcidx(j+1) = kk; + } } } - - retval = Sparse<T> (n, m, new_nzmx); - - octave_idx_type kk = 0; - retval.xcidx(0) = 0; - for (octave_idx_type j = 0; j < m; j++) - { - octave_idx_type jj = idx_j.elem (j); - for (octave_idx_type i = 0; i < n; i++) - { - OCTAVE_QUIT; - - octave_idx_type ii = idx_i.elem (i); - if (ii < nr && jj < nc) - { - for (octave_idx_type k = cidx(jj); k < cidx(jj+1); k++) - { - if (ridx(k) == ii) - { - retval.xdata(kk) = data(k); - retval.xridx(kk++) = i; - } - if (ridx(k) >= ii) - break; - } - } - } - retval.xcidx(j+1) = kk; - } } } - // idx_vector::freeze() printed an error message for us. return retval; @@ -1955,7 +2040,7 @@ octave_idx_type nr = lhs.rows (); octave_idx_type nc = lhs.cols (); - octave_idx_type nz = lhs.nzmax (); + octave_idx_type nz = lhs.nnz (); octave_idx_type n = lhs_idx.freeze (lhs_len, "vector", true, liboctave_wrore_flag); @@ -1971,7 +2056,7 @@ if (rhs_len == n) { - octave_idx_type new_nzmx = lhs.nzmax (); + octave_idx_type new_nzmx = lhs.nnz (); OCTAVE_LOCAL_BUFFER (octave_idx_type, rhs_idx, n); if (! lhs_idx.is_colon ()) @@ -2026,7 +2111,7 @@ { Sparse<LT> tmp (max_idx, 1, new_nzmx); tmp.cidx(0) = 0; - tmp.cidx(1) = tmp.nzmax (); + tmp.cidx(1) = new_nzmx; octave_idx_type i = 0; octave_idx_type ii = 0; @@ -2124,7 +2209,7 @@ } else if (rhs_len == 1) { - octave_idx_type new_nzmx = lhs.nzmax (); + octave_idx_type new_nzmx = lhs.nnz (); RT scalar = rhs.elem (0); bool scalar_non_zero = (scalar != RT ()); lhs_idx.sort (true); @@ -2145,7 +2230,7 @@ { Sparse<LT> tmp (max_idx, 1, new_nzmx); tmp.cidx(0) = 0; - tmp.cidx(1) = tmp.nzmax (); + tmp.cidx(1) = new_nzmx; octave_idx_type i = 0; octave_idx_type ii = 0; @@ -2248,7 +2333,7 @@ if (lhs_len == 0) { - octave_idx_type new_nzmx = rhs.nzmax (); + octave_idx_type new_nzmx = rhs.nnz (); Sparse<LT> tmp (1, rhs_len, new_nzmx); octave_idx_type ii = 0; @@ -2296,7 +2381,7 @@ octave_idx_type lhs_nr = lhs.rows (); octave_idx_type lhs_nc = lhs.cols (); - octave_idx_type lhs_nz = lhs.nzmax (); + octave_idx_type lhs_nz = lhs.nnz (); octave_idx_type rhs_nr = rhs.rows (); octave_idx_type rhs_nc = rhs.cols (); @@ -2364,7 +2449,7 @@ RT scalar = rhs.elem (0, 0); // Count the number of non-zero terms - octave_idx_type new_nzmx = lhs.nzmax (); + octave_idx_type new_nzmx = lhs.nnz (); for (octave_idx_type j = 0; j < m; j++) { octave_idx_type jj = idx_j.elem (j); @@ -2545,7 +2630,7 @@ rhs_idx_j[i] = i; // Count the number of non-zero terms - octave_idx_type new_nzmx = lhs.nzmax (); + octave_idx_type new_nzmx = lhs.nnz (); for (octave_idx_type j = 0; j < m; j++) { octave_idx_type jj = idx_j.elem (j);
--- a/liboctave/SparseCmplxQR.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/SparseCmplxQR.cc Thu Mar 16 17:48:56 2006 +0000 @@ -34,6 +34,8 @@ OCTAVE_LOCAL_BUFFER (double, buf ## tmp, (2 * (n))); \ double _Complex *buf = reinterpret_cast<double _Complex *> (buf ## tmp); +#define OCTAVE_C99_ZERO (0. + 0.iF); + SparseComplexQR::SparseComplexQR_rep::SparseComplexQR_rep (const SparseComplexMatrix& a, int order) { @@ -233,6 +235,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); @@ -262,7 +266,8 @@ x.resize(nc, b_nc); double _Complex *vec = reinterpret_cast<double _Complex *> (x.fortran_vec()); - OCTAVE_C99_COMPLEX (buf, nc > q.S()->m2 ? nc : q.S()->m2); + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_C99_COMPLEX (buf, nbuf); OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); OCTAVE_LOCAL_BUFFER (Complex, B, nr); for (octave_idx_type i = 0; i < nr; i++) @@ -272,6 +277,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); @@ -332,6 +339,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); @@ -382,8 +391,9 @@ x.xcidx(0) = 0; x_nz = b.nzmax(); ii = 0; + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_C99_COMPLEX (buf, nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_C99_COMPLEX (buf, nbuf); OCTAVE_LOCAL_BUFFER (Complex, B, nr); for (octave_idx_type i = 0; i < nr; i++) B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); @@ -392,6 +402,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); @@ -470,6 +482,8 @@ i++, idx+=nc, bidx+=b_nr) { OCTAVE_QUIT; + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -498,7 +512,8 @@ x.resize(nc, b_nc); double _Complex *vec = reinterpret_cast<double _Complex *> (x.fortran_vec()); - OCTAVE_C99_COMPLEX (buf, nc > q.S()->m2 ? nc : q.S()->m2); + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_C99_COMPLEX (buf, nbuf); OCTAVE_LOCAL_BUFFER (Complex, B, nr); for (octave_idx_type i = 0; i < nr; i++) B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); @@ -506,6 +521,8 @@ i++, idx+=nc, bidx+=b_nr) { OCTAVE_QUIT; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); @@ -564,6 +581,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); @@ -614,8 +633,9 @@ x.xcidx(0) = 0; x_nz = b.nzmax(); ii = 0; + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_C99_COMPLEX (buf, nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_C99_COMPLEX (buf, nbuf); OCTAVE_LOCAL_BUFFER (Complex, B, nr); for (octave_idx_type i = 0; i < nr; i++) B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); @@ -624,6 +644,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = OCTAVE_C99_ZERO; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); @@ -675,4 +697,3 @@ ;;; mode: C++ *** ;;; End: *** */ -
--- a/liboctave/SparseQR.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/SparseQR.cc Thu Mar 16 17:48:56 2006 +0000 @@ -170,6 +170,8 @@ for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) { OCTAVE_QUIT; + for (octave_idx_type i = nr; i < S->m2; i++) + buf[i] = 0.; volatile octave_idx_type nm = (nr < nc ? nr : nc); BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (b_nr, S->Pinv, bvec + idx, buf); @@ -222,6 +224,8 @@ i++, idx+=nc, bidx+=b_nr) { OCTAVE_QUIT; + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -249,11 +253,14 @@ } x.resize(nc, b_nc); double *vec = x.fortran_vec(); - OCTAVE_LOCAL_BUFFER (double, buf, nc > q.S()->m2 ? nc : q.S()->m2); + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; i++, idx+=nc, bidx+=b_nr) { OCTAVE_QUIT; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); @@ -311,6 +318,8 @@ OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -359,13 +368,16 @@ x.xcidx(0) = 0; x_nz = b.nzmax(); ii = 0; + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { OCTAVE_QUIT; for (octave_idx_type j = 0; j < b_nr; j++) Xx[j] = b.xelem(j,i); + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); @@ -445,6 +457,8 @@ Xx[j] = std::real (c); Xz[j] = std::imag (c); } + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -459,6 +473,8 @@ CXSPARSE_DNAME (_usolve) (q.N()->U, buf); CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; for (volatile octave_idx_type j = 0; j < nc; j++) @@ -487,9 +503,10 @@ } x.resize(nc, b_nc); Complex *vec = x.fortran_vec(); + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { OCTAVE_QUIT; @@ -499,6 +516,8 @@ Xx[j] = std::real (c); Xz[j] = std::imag (c); } + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); @@ -512,6 +531,10 @@ } BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -575,6 +598,8 @@ Xx[j] = std::real (c); Xz[j] = std::imag (c); } + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; @@ -588,6 +613,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_usolve) (q.N()->U, buf); CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; for (volatile octave_idx_type j = 0; j < nc; j++) @@ -635,9 +664,10 @@ x.xcidx(0) = 0; x_nz = b.nzmax(); ii = 0; + volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nc > q.S()->m2 ? nc : q.S()->m2); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { OCTAVE_QUIT; @@ -647,6 +677,8 @@ Xx[j] = std::real (c); Xz[j] = std::imag (c); } + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); @@ -660,6 +692,10 @@ } BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
--- a/liboctave/SparseType.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/SparseType.cc Thu Mar 16 17:48:56 2006 +0000 @@ -192,7 +192,10 @@ bool found = false; nperm = ncols; - perm = new octave_idx_type [nperm]; + perm = new octave_idx_type [ncols]; + + for (octave_idx_type i = 0; i < ncols; i++) + perm [i] = -1; for (octave_idx_type i = 0; i < nm; i++) { @@ -200,9 +203,8 @@ for (octave_idx_type j = 0; j < ncols; j++) { - if ((a.cidx(j+1) - a.cidx(j)) > 0 && - a.ridx(a.cidx(j+1)-1) == i) + (a.ridx(a.cidx(j+1)-1) == i)) { perm [i] = j; found = true; @@ -215,15 +217,24 @@ } if (found) - typ = SparseType::Permuted_Upper; - else { - delete [] perm; + typ = SparseType::Permuted_Upper; + if (ncols > nrows) + { + octave_idx_type k = nrows; + for (octave_idx_type i = 0; i < ncols; i++) + if (perm [i] == -1) + perm[i] = k++; + } + } + else if (a.cidx(nm) == a.cidx(ncols)) + { nperm = nrows; - perm = new octave_idx_type [nperm]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nperm); + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - for (octave_idx_type i = 0; i < nperm; i++) + for (octave_idx_type i = 0; i < nrows; i++) { perm [i] = -1; tmp [i] = -1; @@ -231,10 +242,10 @@ for (octave_idx_type j = 0; j < ncols; j++) for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - perm [a.ridx(i)] = j; - + perm [a.ridx(i)] = j; + found = true; - for (octave_idx_type i = 0; i < nperm; i++) + for (octave_idx_type i = 0; i < nm; i++) if (perm[i] == -1) { found = false; @@ -246,12 +257,24 @@ } if (found) - for (octave_idx_type i = 0; i < nm; i++) - if (tmp[i] == -1) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) { - found = false; - break; + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } } + } if (found) typ = SparseType::Permuted_Lower; @@ -261,6 +284,27 @@ nperm = 0; } } + else + { + delete [] perm; + nperm = 0; + } + } + + // XXX FIXME XXX + // Disable lower under-determined and upper over-determined problems + // as being detected, and force to treat as singular. As this seems + // to cause issues + if (((typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + && nrows > ncols) || + ((typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + && nrows < ncols)) + { + typ = SparseType::Rectangular; + if (typ == SparseType::Permuted_Upper || + typ == SparseType::Permuted_Lower) + delete [] perm; + nperm = 0; } if (typ == SparseType::Full && ncols != nrows) @@ -473,7 +517,10 @@ bool found = false; nperm = ncols; - perm = new octave_idx_type [nperm]; + perm = new octave_idx_type [ncols]; + + for (octave_idx_type i = 0; i < ncols; i++) + perm [i] = -1; for (octave_idx_type i = 0; i < nm; i++) { @@ -481,9 +528,8 @@ for (octave_idx_type j = 0; j < ncols; j++) { - if ((a.cidx(j+1) - a.cidx(j)) > 0 && - a.ridx(a.cidx(j+1)-1) == i) + (a.ridx(a.cidx(j+1)-1) == i)) { perm [i] = j; found = true; @@ -496,15 +542,24 @@ } if (found) - typ = SparseType::Permuted_Upper; - else { - delete [] perm; + typ = SparseType::Permuted_Upper; + if (ncols > nrows) + { + octave_idx_type k = nrows; + for (octave_idx_type i = 0; i < ncols; i++) + if (perm [i] == -1) + perm[i] = k++; + } + } + else if (a.cidx(nm) == a.cidx(ncols)) + { nperm = nrows; - perm = new octave_idx_type [nperm]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nperm); + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - for (octave_idx_type i = 0; i < nperm; i++) + for (octave_idx_type i = 0; i < nrows; i++) { perm [i] = -1; tmp [i] = -1; @@ -512,10 +567,10 @@ for (octave_idx_type j = 0; j < ncols; j++) for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - perm [a.ridx(i)] = j; - + perm [a.ridx(i)] = j; + found = true; - for (octave_idx_type i = 0; i < nperm; i++) + for (octave_idx_type i = 0; i < nm; i++) if (perm[i] == -1) { found = false; @@ -527,12 +582,24 @@ } if (found) - for (octave_idx_type i = 0; i < nm; i++) - if (tmp[i] == -1) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) { - found = false; - break; + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } } + } if (found) typ = SparseType::Permuted_Lower; @@ -542,6 +609,27 @@ nperm = 0; } } + else + { + delete [] perm; + nperm = 0; + } + } + + // XXX FIXME XXX + // Disable lower under-determined and upper over-determined problems + // as being detected, and force to treat as singular. As this seems + // to cause issues + if (((typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + && nrows > ncols) || + ((typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + && nrows < ncols)) + { + typ = SparseType::Rectangular; + if (typ == SparseType::Permuted_Upper || + typ == SparseType::Permuted_Lower) + delete [] perm; + nperm = 0; } if (typ == SparseType::Full && ncols != nrows)
--- a/liboctave/dSparse.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/dSparse.cc Thu Mar 16 17:48:56 2006 +0000 @@ -48,6 +48,13 @@ #include "oct-sort.h" +// Define whether to use a basic QR solver or one that uses a Dulmange +// Mendelsohn factorization to seperate the problem into under-determined, +// well-determined and over-determined parts and solves them seperately +#ifndef USE_QRSOLVE +#include "sparse-dmsolve.cc" +#endif + // Fortran functions we call. extern "C" { @@ -115,10 +122,10 @@ } SparseMatrix::SparseMatrix (const SparseBoolMatrix &a) - : MSparse<double> (a.rows (), a.cols (), a.nzmax ()) + : MSparse<double> (a.rows (), a.cols (), a.nnz ()) { octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = a.nnz (); for (octave_idx_type i = 0; i < nc + 1; i++) cidx (i) = a.cidx (i); @@ -135,10 +142,10 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type nr_a = a.rows (); octave_idx_type nc_a = a.cols (); - octave_idx_type nz_a = a.nzmax (); + octave_idx_type nz_a = a.nnz (); if (nr != nr_a || nc != nc_a || nz != nz_a) return false; @@ -498,7 +505,7 @@ { octave_idx_type nr = a.rows (); octave_idx_type nc = a.cols (); - octave_idx_type nz = a.nzmax (); + octave_idx_type nz = a.nnz (); SparseMatrix r (nr, nc, nz); for (octave_idx_type i = 0; i < nc +1; i++) @@ -518,7 +525,7 @@ { octave_idx_type nr = a.rows (); octave_idx_type nc = a.cols (); - octave_idx_type nz = a.nzmax (); + octave_idx_type nz = a.nnz (); SparseMatrix r (nr, nc, nz); for (octave_idx_type i = 0; i < nc +1; i++) @@ -560,7 +567,7 @@ { octave_idx_type nr = x.rows (); octave_idx_type nc = x.cols (); - octave_idx_type nz = x.nzmax (); + octave_idx_type nz = x.nnz (); SparseMatrix retval (nr, nc, nz); @@ -613,7 +620,7 @@ gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); else { - r = SparseMatrix (x_nr, x_nc, (x.nzmax () + y.nzmax ())); + r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); octave_idx_type jx = 0; r.cidx (0) = 0; @@ -790,7 +797,7 @@ if (typ == SparseType::Upper || typ == SparseType::Lower) { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type cx = 0; octave_idx_type nz2 = nz; retval = SparseMatrix (nr, nc, nz2); @@ -875,7 +882,7 @@ } else { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); octave_idx_type cx = 0; octave_idx_type nz2 = nz; retval = SparseMatrix (nr, nc, nz2); @@ -1187,8 +1194,9 @@ } Matrix -SparseMatrix::dsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler) const +SparseMatrix::dsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, + double& rcond, solve_singularity_handler, + bool calc_cond) const { Matrix retval; @@ -1220,16 +1228,21 @@ for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) retval(k,j) = b(ridx(i),j) / data (i); - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1240,8 +1253,8 @@ SparseMatrix SparseMatrix::dsolve (SparseType &mattype, const SparseMatrix& b, - octave_idx_type& err, - double& rcond, solve_singularity_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, bool calc_cond) const { SparseMatrix retval; @@ -1263,23 +1276,25 @@ typ == SparseType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; if (typ == SparseType::Diagonal) - for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type j = 0; j < b_nc; j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) { + if (b.ridx(i) >= nm) + break; retval.xridx (ii) = b.ridx(i); retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); } retval.xcidx(j+1) = ii; } else - for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type j = 0; j < b_nc; j++) { for (octave_idx_type l = 0; l < nc; l++) for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) @@ -1301,16 +1316,21 @@ retval.xcidx(j+1) = ii; } - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1321,8 +1341,8 @@ ComplexMatrix SparseMatrix::dsolve (SparseType &mattype, const ComplexMatrix& b, - octave_idx_type& err, - double& rcond, solve_singularity_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, bool calc_cond) const { ComplexMatrix retval; @@ -1354,16 +1374,21 @@ for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) retval(k,j) = b(ridx(i),j) / data (i); - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1375,7 +1400,7 @@ SparseComplexMatrix SparseMatrix::dsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler) const + solve_singularity_handler, bool calc_cond) const { SparseComplexMatrix retval; @@ -1397,7 +1422,7 @@ typ == SparseType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; @@ -1407,6 +1432,8 @@ { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) { + if (b.ridx(i) >= nm) + break; retval.xridx (ii) = b.ridx(i); retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); } @@ -1435,16 +1462,21 @@ retval.xcidx(j+1) = ii; } - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nm; i++) - { - double tmp = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; + if (calc_cond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nm; i++) + { + double tmp = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; } else (*current_liboctave_error_handler) ("incorrect matrix type"); @@ -1456,7 +1488,8 @@ Matrix SparseMatrix::utsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -1480,16 +1513,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Upper) @@ -1511,7 +1547,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1532,37 +1569,42 @@ retval.xelem (perm[i], j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -1581,7 +1623,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1601,45 +1644,50 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -1653,7 +1701,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -1670,7 +1721,8 @@ SparseMatrix SparseMatrix::utsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseMatrix retval; @@ -1693,20 +1745,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -1734,7 +1789,8 @@ if (work[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1777,37 +1833,42 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -1825,7 +1886,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -1867,45 +1929,51 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -1919,7 +1987,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -1935,7 +2006,8 @@ ComplexMatrix SparseMatrix::utsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1959,16 +2031,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Upper) @@ -1990,7 +2065,8 @@ if (cwork[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2011,38 +2087,43 @@ retval.xelem (perm[i], j) = cwork[i]; } - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2061,7 +2142,8 @@ { if (cwork[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2081,46 +2163,52 @@ retval.xelem (i, j) = cwork[i]; } - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2134,7 +2222,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2151,7 +2242,8 @@ SparseComplexMatrix SparseMatrix::utsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -2174,20 +2266,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -2215,7 +2310,8 @@ if (cwork[k] != 0.) { - if (ridx(cidx(kidx+1)-1) != k) + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2258,38 +2354,43 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); i < cidx(iidx+1)-1; i++) + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } } } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2307,7 +2408,8 @@ { if (cwork[k] != 0.) { - if (ridx(cidx(k+1)-1) != k) + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) { err = -2; goto triangular_error; @@ -2349,46 +2451,52 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2402,7 +2510,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2419,7 +2530,8 @@ Matrix SparseMatrix::ltsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -2443,16 +2555,19 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Lower) @@ -2483,7 +2598,7 @@ mini = i; } - if (minr != k) + if (minr != k || data(mini) == 0) { err = -2; goto triangular_error; @@ -2506,49 +2621,55 @@ retval (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -2566,7 +2687,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -2587,47 +2709,52 @@ retval.xelem (i, j) = work[i]; } - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2641,7 +2768,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2658,7 +2788,8 @@ SparseMatrix SparseMatrix::ltsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseMatrix retval; @@ -2681,29 +2812,31 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - - octave_idx_type b_nr = b.rows (); + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); - retval = SparseMatrix (b_nr, b_nc, b_nz); + octave_idx_type b_nz = b.nnz (); + retval = SparseMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; if (typ == SparseType::Permuted_Lower) { - OCTAVE_LOCAL_BUFFER (double, work, nr); + OCTAVE_LOCAL_BUFFER (double, work, nm); octave_idx_type *perm = mattype.triangular_perm (); for (octave_idx_type j = 0; j < b_nc; j++) @@ -2727,7 +2860,7 @@ mini = i; } - if (minr != k) + if (minr != k || data(mini) == 0) { err = -2; goto triangular_error; @@ -2772,54 +2905,60 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nr; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nr; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else { - OCTAVE_LOCAL_BUFFER (double, work, nr); + OCTAVE_LOCAL_BUFFER (double, work, nm); for (octave_idx_type j = 0; j < b_nc; j++) { @@ -2832,7 +2971,8 @@ { if (work[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -2874,47 +3014,52 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -2928,7 +3073,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -2945,7 +3093,8 @@ ComplexMatrix SparseMatrix::ltsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2969,22 +3118,25 @@ double anorm = 0.; double ainvnorm = 0.; octave_idx_type b_nc = b.cols (); - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } if (typ == SparseType::Permuted_Lower) { retval.resize (nc, b_nc); - OCTAVE_LOCAL_BUFFER (Complex, cwork, nr); + OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); octave_idx_type *perm = mattype.triangular_perm (); for (octave_idx_type j = 0; j < b_nc; j++) @@ -3008,7 +3160,7 @@ mini = i; } - if (minr != k) + if (minr != k || data(mini) == 0) { err = -2; goto triangular_error; @@ -3031,50 +3183,56 @@ retval (i, j) = cwork[i]; } - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -3093,7 +3251,8 @@ { if (cwork[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -3113,48 +3272,53 @@ retval.xelem (i, j) = cwork[i]; } - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -3168,7 +3332,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -3185,7 +3352,8 @@ SparseComplexMatrix SparseMatrix::ltsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3208,20 +3376,23 @@ { double anorm = 0.; double ainvnorm = 0.; - rcond = 0.; - - // Calculate the 1-norm of matrix for rcond calculation - for (octave_idx_type j = 0; j < nc; j++) - { - double atmp = 0.; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - atmp += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; + rcond = 1.; + + if (calc_cond) + { + // Calculate the 1-norm of matrix for rcond calculation + for (octave_idx_type j = 0; j < nc; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } } octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nzmax (); + octave_idx_type b_nz = b.nnz (); retval = SparseComplexMatrix (nc, b_nc, b_nz); retval.xcidx(0) = 0; octave_idx_type ii = 0; @@ -3253,7 +3424,7 @@ mini = i; } - if (minr != k) + if (minr != k || data(mini) == 0) { err = -2; goto triangular_error; @@ -3298,50 +3469,56 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) { - octave_idx_type minr = nr; - octave_idx_type mini = 0; - - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - if (perm[ridx(i)] < minr) - { - minr = perm[ridx(i)]; - mini = i; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + if (work[k] != 0.) { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); + octave_idx_type minr = nr; + octave_idx_type mini = 0; + + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + if (perm[ridx(i)] < minr) + { + minr = perm[ridx(i)]; + mini = i; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } } } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; + rcond = 1. / ainvnorm / anorm; } } else @@ -3359,7 +3536,8 @@ { if (cwork[k] != 0.) { - if (ridx(cidx(k)) != k) + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) { err = -2; goto triangular_error; @@ -3401,48 +3579,53 @@ retval.maybe_compress (); - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) { - - if (work[k] != 0.) + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + + if (work[k] != 0.) { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } } } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - } - - rcond = 1. / ainvnorm / anorm; + rcond = 1. / ainvnorm / anorm; + } + } triangular_error: if (err != 0) { if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -3456,7 +3639,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision, rcond = %g", @@ -3471,9 +3657,10 @@ } Matrix -SparseMatrix::trisolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseMatrix::trisolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -3484,6 +3671,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3602,7 +3792,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3619,8 +3812,10 @@ } SparseMatrix -SparseMatrix::trisolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler sing_handler) const +SparseMatrix::trisolve (SparseType &mattype, const SparseMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseMatrix retval; @@ -3631,6 +3826,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3689,13 +3887,16 @@ ("unrecoverable error in dgttrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3703,8 +3904,9 @@ } else { + rcond = 1.0; char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); + volatile octave_idx_type x_nz = b.nnz (); octave_idx_type b_nc = b.cols (); retval = SparseMatrix (nr, b_nc, x_nz); retval.xcidx(0) = 0; @@ -3768,8 +3970,10 @@ } ComplexMatrix -SparseMatrix::trisolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler sing_handler) const +SparseMatrix::trisolve (SparseType &mattype, const ComplexMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -3780,6 +3984,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3908,7 +4115,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -3923,8 +4133,9 @@ SparseComplexMatrix SparseMatrix::trisolve (SparseType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3935,6 +4146,9 @@ if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) (*current_liboctave_error_handler) ("matrix dimension mismatch solution of linear equations"); + else if (calc_cond) + (*current_liboctave_error_handler) + ("calculation of condition number not implemented"); else { // Print spparms("spumoni") info if requested @@ -3993,13 +4207,16 @@ ("unrecoverable error in dgttrf"); else { - rcond = 0.0; if (err != 0) { + rcond = 0.0; err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4015,7 +4232,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); + volatile octave_idx_type x_nz = b.nnz (); volatile octave_idx_type ii = 0; retval = SparseComplexMatrix (b_nr, b_nc, x_nz); @@ -4112,9 +4329,10 @@ } Matrix -SparseMatrix::bsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseMatrix::bsolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -4156,7 +4374,9 @@ } // Calculate the norm of the matrix, for later use. - // double anorm = m_band.abs().sum().row(0).max(); + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); char job = 'L'; F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), @@ -4168,79 +4388,80 @@ ("unrecoverable error in dpbtrf"); else { - rcond = 0.0; if (err != 0) { // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); typ = SparseType::Banded; + rcond = 0.0; err = 0; } else { - // Unfortunately, the time to calculate the condition - // number is dominant for narrow banded matrices and - // so we rely on the "err" flag from xPBTRF to flag - // singularity. The commented code below is left here - // for reference - - //Array<double> z (3 * nr); - //double *pz = z.fortran_vec (); - //Array<int> iz (nr); - //int *piz = iz.fortran_vec (); - // - //F77_XFCN (dpbcon, DGBCON, - // (F77_CONST_CHAR_ARG2 (&job, 1), - // nr, n_lower, tmp_data, ldm, - // anorm, rcond, pz, piz, err - // F77_CHAR_ARG_LEN (1))); - // - // - //if (f77_exception_encountered) - // (*current_liboctave_error_handler) - // ("unrecoverable error in dpbcon"); - // - //if (err != 0) - // err = -2; - // - //volatile double rcond_plus_one = rcond + 1.0; - // - //if (rcond_plus_one == 1.0 || xisnan (rcond)) - // { - // err = -2; - // - // if (sing_handler) - // sing_handler (rcond); - // else - // (*current_liboctave_error_handler) - // ("matrix singular to machine precision, rcond = %g", - // rcond); - // } - //else - // REST OF CODE, EXCEPT rcond=1 - - rcond = 1.; - retval = b; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, b_nc, tmp_data, - ldm, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, b_nc, tmp_data, + ldm, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + } } } } @@ -4269,6 +4490,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4282,13 +4517,16 @@ { // Throw-away extra info LAPACK gives so as to not // change output. - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4296,59 +4534,65 @@ } else { - char job = '1'; - - // Unfortunately, the time to calculate the condition - // number is dominant for narrow banded matrices and - // so we rely on the "err" flag from xPBTRF to flag - // singularity. The commented code below is left here - // for reference - - //F77_XFCN (dgbcon, DGBCON, - // (F77_CONST_CHAR_ARG2 (&job, 1), - // nc, n_lower, n_upper, tmp_data, ldm, pipvt, - // anorm, rcond, pz, piz, err - // F77_CHAR_ARG_LEN (1))); - // - //if (f77_exception_encountered) - // (*current_liboctave_error_handler) - // ("unrecoverable error in dgbcon"); - // - // if (err != 0) - // err = -2; - // - //volatile double rcond_plus_one = rcond + 1.0; - // - //if (rcond_plus_one == 1.0 || xisnan (rcond)) - // { - // err = -2; - // - // if (sing_handler) - // sing_handler (rcond); - // else - // (*current_liboctave_error_handler) - // ("matrix singular to machine precision, rcond = %g", - // rcond); - // } - //else - // REST OF CODE, EXCEPT rcond=1 - - rcond = 1.; - retval = b; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - job = 'N'; - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, b_nc, tmp_data, - ldm, pipvt, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); + if (calc_cond) + { + char job = '1'; + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, b_nc, tmp_data, + ldm, pipvt, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + } } } } @@ -4360,8 +4604,10 @@ } SparseMatrix -SparseMatrix::bsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler sing_handler) const +SparseMatrix::bsolve (SparseType &mattype, const SparseMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseMatrix retval; @@ -4403,6 +4649,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4413,75 +4664,118 @@ ("unrecoverable error in dpbtrf"); else { - rcond = 0.0; if (err != 0) { mattype.mark_as_unsymmetric (); typ = SparseType::Banded; + rcond = 0.0; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); - volatile octave_idx_type ii = 0; - retval = SparseMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) + { + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) { - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b.elem (i, j); - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b.elem (i, j); + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + double tmp = Bx[i]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * + (b_nc - j) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + retval.xdata(ii) = tmp; + retval.xridx(ii++) = i; + } + } + retval.xcidx(j+1) = ii; } - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - double tmp = Bx[i]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - j) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - retval.xdata(ii) = tmp; - retval.xridx(ii++) = i; - } - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4509,6 +4803,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4520,13 +4828,16 @@ ("unrecoverable error in dgbtrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4534,60 +4845,105 @@ } else { - char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); - octave_idx_type b_nc = b.cols (); - retval = SparseMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, work, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - work[b.ridx(i)] = b.data(i); - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, work, b.rows (), err - F77_CHAR_ARG_LEN (1))); - + char job = '1'; + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, work, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; + for (octave_idx_type i = 0; i < nr; i++) + work[i] = 0.; + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + work[b.ridx(i)] = b.data(i); + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, work, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (work[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; } - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (work[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -4599,8 +4955,10 @@ } ComplexMatrix -SparseMatrix::bsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler sing_handler) const +SparseMatrix::bsolve (SparseType &mattype, const ComplexMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4642,6 +5000,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4652,81 +5015,123 @@ ("unrecoverable error in dpbtrf"); else { - rcond = 0.0; if (err != 0) { // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); typ = SparseType::Banded; + rcond = 0.0; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - retval.resize (b_nr, b_nc); + if (calc_cond) + { + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + retval.resize (b_nr, b_nc); - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < b_nr; i++) + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bz, b.rows(), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + retval (i, j) = Complex (Bx[i], Bz[i]); } - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bz, b.rows(), err - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; - } - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - retval (i, j) = Complex (Bx[i], Bz[i]); } } } @@ -4755,6 +5160,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -4766,13 +5185,16 @@ ("unrecoverable error in dgbtrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) + { sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -4780,50 +5202,94 @@ } else { - char job = 'N'; - octave_idx_type b_nc = b.cols (); - retval.resize (nr,b_nc); - - OCTAVE_LOCAL_BUFFER (double, Bz, nr); - OCTAVE_LOCAL_BUFFER (double, Bx, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - for (octave_idx_type i = 0; i < nr; i++) + char job = '1'; + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + octave_idx_type b_nc = b.cols (); + retval.resize (nr,b_nc); + + OCTAVE_LOCAL_BUFFER (double, Bz, nr); + OCTAVE_LOCAL_BUFFER (double, Bx, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - Complex c = b (i, j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bx, b.rows (), err - F77_CHAR_ARG_LEN (1))); + for (octave_idx_type i = 0; i < nr; i++) + { + Complex c = b (i, j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bx, b.rows (), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bz, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + for (octave_idx_type i = 0; i < nr; i++) + retval (i, j) = Complex (Bx[i], Bz[i]); } - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bz, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; - } - - for (octave_idx_type i = 0; i < nr; i++) - retval (i, j) = Complex (Bx[i], Bz[i]); } } } @@ -4837,8 +5303,9 @@ SparseComplexMatrix SparseMatrix::bsolve (SparseType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -4880,6 +5347,11 @@ m_band(ri - j, j) = data(i); } + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + anorm = m_band.abs().sum().row(0).max(); + char job = 'L'; F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, n_lower, tmp_data, ldm, err @@ -4890,7 +5362,6 @@ ("unrecoverable error in dpbtrf"); else { - rcond = 0.0; if (err != 0) { // Matrix is not positive definite!! Fall through to @@ -4898,105 +5369,148 @@ mattype.mark_as_unsymmetric (); typ = SparseType::Banded; + rcond = 0.0; err = 0; } else { - rcond = 1.; - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nzmax (); - volatile octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - - for (octave_idx_type i = 0; i < b_nr; i++) + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bz, b_nr, err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; - } - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dpbtrs"); + err = -1; + break; + } + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + err = -1; + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = + Complex (Bx[i], Bz[i]); + } + + retval.xcidx(j+1) = ii; } - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bz, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dpbtrs"); - err = -1; - break; - } - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - err = -1; - break; - } - - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = - Complex (Bx[i], Bz[i]); - } - - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -5024,6 +5538,20 @@ for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); + // Calculate the norm of the matrix, for later use. + double anorm; + if (calc_cond) + { + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + atmp += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + Array<octave_idx_type> ipvt (nr); octave_idx_type *pipvt = ipvt.fortran_vec (); @@ -5035,13 +5563,16 @@ ("unrecoverable error in dgbtrf"); else { - rcond = 0.0; if (err != 0) { err = -2; + rcond = 0.0; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("matrix singular to machine precision"); @@ -5049,82 +5580,127 @@ } else { - char job = 'N'; - volatile octave_idx_type x_nz = b.nzmax (); - octave_idx_type b_nc = b.cols (); - retval = SparseComplexMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, Bx, nr); - OCTAVE_LOCAL_BUFFER (double, Bz, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) + if (calc_cond) { - for (octave_idx_type i = 0; i < nr; i++) + char job = '1'; + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + int *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgbcon"); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseComplexMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, Bx, nr); + OCTAVE_LOCAL_BUFFER (double, Bz, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) { - Bx[i] = 0.; - Bz[i] = 0.; - } - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - { - Complex c = b.data(i); - Bx[b.ridx(i)] = std::real (c); - Bz[b.ridx(i)] = std::imag (c); - } - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bx, b.rows (), err - F77_CHAR_ARG_LEN (1))); + for (octave_idx_type i = 0; i < nr; i++) + { + Bx[i] = 0.; + Bz[i] = 0.; + } + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + { + Complex c = b.data(i); + Bx[b.ridx(i)] = std::real (c); + Bz[b.ridx(i)] = std::imag (c); + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bx, b.rows (), err + F77_CHAR_ARG_LEN (1))); - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bz, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + { + (*current_liboctave_error_handler) + ("unrecoverable error in dgbtrs"); + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = + Complex (Bx[i], Bz[i]); + } + retval.xcidx(j+1) = ii; } - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bz, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("unrecoverable error in dgbtrs"); - break; - } - - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = - Complex (Bx[i], Bz[i]); - } - retval.xcidx(j+1) = ii; + retval.maybe_compress (); } - - retval.maybe_compress (); } } } @@ -5136,8 +5712,9 @@ } void * -SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, Matrix &Info, - solve_singularity_handler sing_handler) const +SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, + Matrix &Info, solve_singularity_handler sing_handler, + bool calc_cond) const { // The return values void *Numeric = 0; @@ -5199,7 +5776,10 @@ &Numeric, control, info) ; UMFPACK_DNAME (free_symbolic) (&Symbolic) ; - rcond = Info (UMFPACK_RCOND); + if (calc_cond) + rcond = Info (UMFPACK_RCOND); + else + rcond = 1.; volatile double rcond_plus_one = rcond + 1.0; if (status == UMFPACK_WARNING_singular_matrix || @@ -5244,9 +5824,10 @@ } Matrix -SparseMatrix::fsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const +SparseMatrix::fsolve (SparseType &mattype, const Matrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -5355,7 +5936,11 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.0; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5373,7 +5958,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5416,7 +6004,7 @@ #ifdef HAVE_UMFPACK Matrix Control, Info; void *Numeric = - factorize (err, rcond, Control, Info, sing_handler); + factorize (err, rcond, Control, Info, sing_handler, calc_cond); if (err == 0) { @@ -5454,6 +6042,9 @@ UMFPACK_DNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5466,8 +6057,10 @@ } SparseMatrix -SparseMatrix::fsolve (SparseType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const +SparseMatrix::fsolve (SparseType &mattype, const SparseMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseMatrix retval; @@ -5586,7 +6179,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5604,7 +6200,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5652,7 +6251,7 @@ #ifdef HAVE_UMFPACK Matrix Control, Info; void *Numeric = factorize (err, rcond, Control, Info, - sing_handler); + sing_handler, calc_cond); if (err == 0) { @@ -5670,7 +6269,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - octave_idx_type x_nz = b.nzmax (); + octave_idx_type x_nz = b.nnz (); octave_idx_type ii = 0; retval = SparseMatrix (b_nr, b_nc, x_nz); @@ -5722,6 +6321,9 @@ UMFPACK_DNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5734,8 +6336,10 @@ } ComplexMatrix -SparseMatrix::fsolve (SparseType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const +SparseMatrix::fsolve (SparseType &mattype, const ComplexMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -5844,7 +6448,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.0; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -5862,7 +6469,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -5905,7 +6515,7 @@ #ifdef HAVE_UMFPACK Matrix Control, Info; void *Numeric = factorize (err, rcond, Control, Info, - sing_handler); + sing_handler, calc_cond); if (err == 0) { @@ -5962,6 +6572,9 @@ UMFPACK_DNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); + #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -5976,7 +6589,8 @@ SparseComplexMatrix SparseMatrix::fsolve (SparseType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -6095,7 +6709,10 @@ BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; L = CHOLMOD_NAME(analyze) (A, cm); CHOLMOD_NAME(factorize) (A, L, cm); - rcond = CHOLMOD_NAME(rcond)(L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.0; END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (rcond == 0.0) @@ -6113,7 +6730,10 @@ err = -2; if (sing_handler) - sing_handler (rcond); + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } else (*current_liboctave_error_handler) ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", @@ -6162,7 +6782,7 @@ #ifdef HAVE_UMFPACK Matrix Control, Info; void *Numeric = factorize (err, rcond, Control, Info, - sing_handler); + sing_handler, calc_cond); if (err == 0) { @@ -6180,7 +6800,7 @@ // Take a first guess that the number of non-zero terms // will be as many as in b - octave_idx_type x_nz = b.nzmax (); + octave_idx_type x_nz = b.nnz (); octave_idx_type ii = 0; retval = SparseComplexMatrix (b_nr, b_nc, x_nz); @@ -6242,6 +6862,8 @@ UMFPACK_DNAME (free_numeric) (&Numeric); } + else + mattype.mark_as_rectangular (); #else (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif @@ -6280,30 +6902,44 @@ double& rcond, solve_singularity_handler sing_handler) const { + Matrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); + // Only calculate the condition number for CHOLMOD/UMFPACK if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return Matrix (); } + + // Rectangular or one of the above solvers flags a singular matrix + if (mattype.type (false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err); +#endif + } + + return retval; } SparseMatrix @@ -6334,30 +6970,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + SparseMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return SparseMatrix (); } + + if (mattype.type (false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<SparseMatrix, SparseMatrix, + SparseMatrix> (*this, b, err); +#endif + } + + return retval; } ComplexMatrix @@ -6388,30 +7037,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + ComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<ComplexMatrix, SparseMatrix, + ComplexMatrix> (*this, b, err); +#endif + } + + return retval; } SparseComplexMatrix @@ -6442,30 +7104,43 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { + SparseComplexMatrix retval; int typ = mattype.type (false); if (typ == SparseType::Unknown) typ = mattype.type (*this); if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - return dsolve (mattype, b, err, rcond, sing_handler); + retval = dsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - return utsolve (mattype, b, err, rcond, sing_handler); + retval = utsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - return ltsolve (mattype, b, err, rcond, sing_handler); + retval = ltsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) - return bsolve (mattype, b, err, rcond, sing_handler); + retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Tridiagonal || typ == SparseType::Tridiagonal_Hermitian) - return trisolve (mattype, b, err, rcond, sing_handler); + retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == SparseType::Full || typ == SparseType::Hermitian) - return fsolve (mattype, b, err, rcond, sing_handler); - else + retval = fsolve (mattype, b, err, rcond, sing_handler, true); + else if (typ != SparseType::Rectangular) { - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); + (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } + + if (mattype.type(false) == SparseType::Rectangular) + { + rcond = 1.; +#ifdef USE_QRSOLVE + retval = qrsolve (*this, b, err); +#else + retval = dmsolve<SparseComplexMatrix, SparseMatrix, + SparseComplexMatrix> (*this, b, err); +#endif + } + + return retval; } ColumnVector @@ -6703,136 +7378,6 @@ return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); } -Matrix -SparseMatrix::lssolve (const Matrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -Matrix -SparseMatrix::lssolve (const Matrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -Matrix -SparseMatrix::lssolve (const Matrix& b, octave_idx_type& info, octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -SparseMatrix -SparseMatrix::lssolve (const SparseMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseMatrix -SparseMatrix::lssolve (const SparseMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseMatrix -SparseMatrix::lssolve (const SparseMatrix& b, octave_idx_type& info, octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -ComplexMatrix -SparseMatrix::lssolve (const ComplexMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexMatrix -SparseMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -SparseComplexMatrix -SparseMatrix::lssolve (const SparseComplexMatrix& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseMatrix::lssolve (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -SparseComplexMatrix -SparseMatrix::lssolve (const SparseComplexMatrix& b, octave_idx_type& info, - octave_idx_type&) const -{ - return qrsolve (*this, b, info); -} - -ColumnVector -SparseMatrix::lssolve (const ColumnVector& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ColumnVector -SparseMatrix::lssolve (const ColumnVector& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ColumnVector -SparseMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, octave_idx_type& rank) const -{ - Matrix tmp (b); - return lssolve (tmp, info, rank).column (static_cast<octave_idx_type> (0)); -} - -ComplexColumnVector -SparseMatrix::lssolve (const ComplexColumnVector& b) const -{ - octave_idx_type info; - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info) const -{ - octave_idx_type rank; - return lssolve (b, info, rank); -} - -ComplexColumnVector -SparseMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const -{ - ComplexMatrix tmp (b); - return lssolve (tmp, info, rank).column (static_cast<octave_idx_type> (0)); -} - // other operations. SparseMatrix @@ -6840,7 +7385,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); bool f_zero = (f(0.0) == 0.0); // Count number of non-zero elements @@ -6890,7 +7435,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); bool f_zero = f(0.0); // Count number of non-zero elements @@ -6945,7 +7490,7 @@ bool SparseMatrix::any_element_is_negative (bool neg_zero) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); if (neg_zero) { @@ -6966,7 +7511,7 @@ bool SparseMatrix::any_element_is_inf_or_nan (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -6981,7 +7526,7 @@ bool SparseMatrix::all_elements_are_int_or_inf_or_nan (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -7001,7 +7546,7 @@ bool SparseMatrix::all_integers (double& max_val, double& min_val) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); if (nel == 0) return false; @@ -7029,7 +7574,7 @@ bool SparseMatrix::too_large_for_float (void) const { - octave_idx_type nel = nzmax (); + octave_idx_type nel = nnz (); for (octave_idx_type i = 0; i < nel; i++) { @@ -7047,7 +7592,7 @@ { octave_idx_type nr = rows (); octave_idx_type nc = cols (); - octave_idx_type nz1 = nzmax (); + octave_idx_type nz1 = nnz (); octave_idx_type nz2 = nr*nc - nz1; SparseBoolMatrix r (nr, nc, nz2); @@ -7133,7 +7678,7 @@ SparseMatrix SparseMatrix::abs (void) const { - octave_idx_type nz = nzmax (); + octave_idx_type nz = nnz (); SparseMatrix retval (*this); @@ -7359,32 +7904,19 @@ SparseMatrix operator * (const SparseMatrix& m, const SparseMatrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? Is it faster?? -#else - // Use Andy's sparse matrix multiply function - SPARSE_SPARSE_MUL (SparseMatrix, double); -#endif + SPARSE_SPARSE_MUL (SparseMatrix, double, double); } Matrix operator * (const Matrix& m, const SparseMatrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? Is it faster?? -#else - FULL_SPARSE_MUL (Matrix, double); -#endif + FULL_SPARSE_MUL (Matrix, double, 0.); } Matrix operator * (const SparseMatrix& m, const Matrix& a) { -#ifdef HAVE_SPARSE_BLAS - // XXX FIXME XXX Isn't there a sparse BLAS ?? Is it faster?? -#else - SPARSE_FULL_MUL (Matrix, double); -#endif + SPARSE_FULL_MUL (Matrix, double, 0.); } // XXX FIXME XXX -- it would be nice to share code among the min/max @@ -7474,7 +8006,7 @@ gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else { - r = SparseMatrix (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; r.cidx (0) = 0; @@ -7624,7 +8156,7 @@ gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else { - r = SparseMatrix (a_nr, a_nc, (a.nzmax () + b.nzmax ())); + r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); octave_idx_type jx = 0; r.cidx (0) = 0;
--- a/liboctave/dSparse.h Thu Mar 16 17:36:52 2006 +0000 +++ b/liboctave/dSparse.h Thu Mar 16 17:48:56 2006 +0000 @@ -136,91 +136,128 @@ private: // Diagonal matrix solvers - Matrix dsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix dsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix dsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix dsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix dsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Upper triangular matrix solvers - Matrix utsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix utsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix utsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix utsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix utsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Lower triangular matrix solvers - Matrix ltsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix ltsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix ltsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix ltsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix ltsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Tridiagonal matrix solvers - Matrix trisolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix trisolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix trisolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix trisolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix trisolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Banded matrix solvers (umfpack/cholesky) - Matrix bsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix bsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix bsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix bsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix bsolve (SparseType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + solve_singularity_handler sing_handler, + bool calc_cond = false) const; // Full matrix solvers (umfpack/cholesky) - void * factorize (octave_idx_type& err, double &rcond, Matrix &Control, Matrix &Info, - solve_singularity_handler sing_handler) const; + void * factorize (octave_idx_type& err, double &rcond, Matrix &Control, + Matrix &Info, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - Matrix fsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + Matrix fsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; - ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; - SparseMatrix fsolve (SparseType &typ, const SparseMatrix& b, octave_idx_type& info, - double& rcond, solve_singularity_handler sing_handler) const; + SparseMatrix fsolve (SparseType &typ, const SparseMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; SparseComplexMatrix fsolve (SparseType &typ, const SparseComplexMatrix& b, - octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const; + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; public: // Generic interface to solver with no probing of type @@ -317,35 +354,6 @@ double& rcond, solve_singularity_handler sing_handler) const; - // Minimum-norm solvers - Matrix lssolve (const Matrix& b) const; - Matrix lssolve (const Matrix& b, octave_idx_type& info) const; - Matrix lssolve (const Matrix& b, octave_idx_type& info, octave_idx_type& rank) const; - - ComplexMatrix lssolve (const ComplexMatrix& b) const; - ComplexMatrix lssolve (const ComplexMatrix& b, octave_idx_type& info) const; - ComplexMatrix lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const; - - SparseMatrix lssolve (const SparseMatrix& b) const; - SparseMatrix lssolve (const SparseMatrix& b, octave_idx_type& info) const; - SparseMatrix lssolve (const SparseMatrix& b, octave_idx_type& info, octave_idx_type& rank) const; - - SparseComplexMatrix lssolve (const SparseComplexMatrix& b) const; - SparseComplexMatrix lssolve (const SparseComplexMatrix& b, - octave_idx_type& info) const; - SparseComplexMatrix lssolve (const SparseComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const; - - ColumnVector lssolve (const ColumnVector& b) const; - ColumnVector lssolve (const ColumnVector& b, octave_idx_type& info) const; - ColumnVector lssolve (const ColumnVector& b, octave_idx_type& info, octave_idx_type& rank) const; - - ComplexColumnVector lssolve (const ComplexColumnVector& b) const; - ComplexColumnVector lssolve (const ComplexColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const; - // other operations SparseMatrix map (d_d_Mapper f) const; SparseBoolMatrix map (b_d_Mapper f) const;
--- a/scripts/ChangeLog Thu Mar 16 17:36:52 2006 +0000 +++ b/scripts/ChangeLog Thu Mar 16 17:48:56 2006 +0000 @@ -1,3 +1,11 @@ +2006-03-16 David Bateman <dbateman@free.fr> + + * testfun/test.m: Clear last warning before warning test to avoid + issues with previously set warnings. + * build_sparse_test.sh: Tests for multiple RHS for rectanguar + sparse matrices. Force matrix type from spqr solution to be + singular to force QR solvers to be used for assert. + 2006-03-16 William Poetra Yoga Hadisoeseno <williampoetra@gmail.com> * strings/strfind.m: New file.
--- a/scripts/testfun/test.m Thu Mar 16 17:36:52 2006 +0000 +++ b/scripts/testfun/test.m Thu Mar 16 17:48:56 2006 +0000 @@ -607,6 +607,9 @@ %!error test("test", 'bogus'); # test without pattern +%!test +%! lastwarn(); # clear last warning just in case + %!warning <warning message> warning('warning message') %!## test of shared variables
--- a/src/ChangeLog Thu Mar 16 17:36:52 2006 +0000 +++ b/src/ChangeLog Thu Mar 16 17:48:56 2006 +0000 @@ -1,3 +1,18 @@ +2006-03-16 David Bateman <dbateman@free.fr> + + * sparse-xdiv.cc (result_ok): delete. + (xdiv, xleftdiv): Simplify to use version of SpareMatrix::solve + and SparseComplexMatrix::solve which internally treats rectangular + and singular matrices. + * DLD-FUNCTIONS/luinc.cc: Remove error test for singular matrix as + QR solver now implemented. + * DLD-FUNCTIONS/matrix_type.cc (Fmatrix_type): Paranoid check on + error_state. Disable tests for the detection of underdetermined + lower and over-determined upper matrix due to problems with + non minimum norm solutions. + * DLD-FUNCTIONS/spqr.cc: Warning for issue of use of Fspqr for + under-determined problems. + 2006-03-16 John W. Eaton <jwe@octave.org> * __gnuplot_raw__.l: Move here from DLD-FUNCTIONS/__gnuplot_raw__.l.
--- a/src/DLD-FUNCTIONS/luinc.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/src/DLD-FUNCTIONS/luinc.cc Thu Mar 16 17:48:56 2006 +0000 @@ -296,8 +296,6 @@ %! [l,u]=luinc(a,opts); %! assert(l*u, sparse([1i,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]),1e-10); -%!error splu(sparse([1i,2,0,0;0,1,2,0;1e-14,0,3,0;0,0,0,1])); - */ /*
--- a/src/DLD-FUNCTIONS/matrix_type.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/src/DLD-FUNCTIONS/matrix_type.cc Thu Mar 16 17:48:56 2006 +0000 @@ -118,8 +118,13 @@ if (mattyp.is_unknown ()) { - mattyp = SparseType (args(0).sparse_complex_matrix_value ()); - ((octave_sparse_complex_matrix &)rep).sparse_type (mattyp); + SparseComplexMatrix m = + args(0).sparse_complex_matrix_value (); + if (!error_state) + { + mattyp = SparseType (m); + ((octave_sparse_complex_matrix &)rep).sparse_type (mattyp); + } } } else @@ -128,8 +133,12 @@ if (mattyp.is_unknown ()) { - mattyp = SparseType (args(0).sparse_matrix_value ()); - ((octave_sparse_matrix &)rep).sparse_type (mattyp); + SparseMatrix m = args(0).sparse_matrix_value (); + if (!error_state) + { + mattyp = SparseType (m); + ((octave_sparse_matrix &)rep).sparse_type (mattyp); + } } } @@ -291,6 +300,11 @@ } /* + +## XXX FIXME XXX +## Disable tests for lower under-determined and upper over-determined +## matrices and this detection is disabled in SparseType due to issues +## of non minimum norm solution being found. %!assert(matrix_type(speye(10,10)),"Diagonal"); %!assert(matrix_type(speye(10,10)([2:10,1],:)),"Permuted Diagonal"); @@ -320,12 +334,12 @@ %!assert(matrix_type(speye(10,11)([2:10,1],:)),"Permuted Diagonal"); %!assert(matrix_type(speye(11,10)),"Diagonal"); %!assert(matrix_type(speye(11,10)([2:11,1],:)),"Permuted Diagonal"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]]),"Upper"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]](:,[2,1,3:12])),"Permuted Upper"); +%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]]),"Upper"); +%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]](:,[2,1,3:12])),"Permuted Upper"); %!assert(matrix_type([speye(11,9),[1;sparse(8,1);1;0]]),"Upper"); %!assert(matrix_type([speye(11,9),[1;sparse(8,1);1;0]](:,[2,1,3:10])),"Permuted Upper"); -%!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]),"Lower"); -%!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]([2,1,3:12],:)),"Permuted Lower"); +%#!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]),"Lower"); +%#!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]([2,1,3:12],:)),"Permuted Lower"); %!assert(matrix_type([speye(9,11);[1,sparse(1,8),1,0]]),"Lower"); %!assert(matrix_type([speye(9,11);[1,sparse(1,8),1,0]]([2,1,3:10],:)),"Permuted Lower"); %!assert(matrix_type(spdiags(randn(10,4),[-2:1],10,9)),"Rectangular") @@ -358,12 +372,12 @@ %!assert(matrix_type(1i*speye(10,11)([2:10,1],:)),"Permuted Diagonal"); %!assert(matrix_type(1i*speye(11,10)),"Diagonal"); %!assert(matrix_type(1i*speye(11,10)([2:11,1],:)),"Permuted Diagonal"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]]),"Upper"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]](:,[2,1,3:12])),"Permuted Upper"); +%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]]),"Upper"); +%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]](:,[2,1,3:12])),"Permuted Upper"); %!assert(matrix_type([speye(11,9),[1i;sparse(8,1);1i;0]]),"Upper"); %!assert(matrix_type([speye(11,9),[1i;sparse(8,1);1i;0]](:,[2,1,3:10])),"Permuted Upper"); -%!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]),"Lower"); -%!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]([2,1,3:12],:)),"Permuted Lower"); +%#!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]),"Lower"); +%#!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]([2,1,3:12],:)),"Permuted Lower"); %!assert(matrix_type([speye(9,11);[1i,sparse(1,8),1i,0]]),"Lower"); %!assert(matrix_type([speye(9,11);[1i,sparse(1,8),1i,0]]([2,1,3:10],:)),"Permuted Lower"); %!assert(matrix_type(1i*spdiags(randn(10,4),[-2:1],10,9)),"Rectangular")
--- a/src/DLD-FUNCTIONS/spqr.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/src/DLD-FUNCTIONS/spqr.cc Thu Mar 16 17:48:56 2006 +0000 @@ -114,6 +114,8 @@ { retval(1) = q.R (economy); retval(0) = q.C (args(1).complex_matrix_value ()); + if (args(0).rows() < args(0).columns()) + warning ("spqr: non minimum norm solution for under-determined problem"); } else retval(0) = q.R (economy); @@ -128,6 +130,8 @@ { retval(1) = q.R (economy); retval(0) = q.C (args(1).matrix_value ()); + if (args(0).rows() < args(0).columns()) + warning ("spqr: non minimum norm solution for under-determined problem"); } else retval(0) = q.R (economy);
--- a/src/sparse-xdiv.cc Thu Mar 16 17:36:52 2006 +0000 +++ b/src/sparse-xdiv.cc Thu Mar 16 17:48:56 2006 +0000 @@ -36,12 +36,6 @@ #include "oct-spparms.h" #include "sparse-xdiv.h" -static inline bool -result_ok (octave_idx_type info) -{ - return (info != -2 && info != -1); -} - static void solve_singularity_warning (double rcond) { @@ -132,24 +126,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - Matrix result = btmp.solve (btyp, atmp, info, rcond, - solve_singularity_warning); + double rcond = 0.0; + Matrix result = btmp.solve (btyp, atmp, info, rcond, + solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return Matrix (result.transpose ()); - } - } - - octave_idx_type rank; - Matrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.transpose (); } @@ -165,24 +146,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -198,24 +166,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -231,24 +186,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -264,24 +206,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - SparseMatrix result = btmp.solve (btyp, atmp, info, rcond, - solve_singularity_warning); + double rcond = 0.0; + SparseMatrix result = btmp.solve (btyp, atmp, info, rcond, + solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return SparseMatrix (result.transpose ()); - } - } - - octave_idx_type rank; - SparseMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.transpose (); } @@ -297,24 +226,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - SparseComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -330,24 +246,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - SparseComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -363,24 +266,11 @@ SparseType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - if (result_ok (info)) - { - typ = btyp.transpose (); - return result.hermitian (); - } - } - - octave_idx_type rank; - SparseComplexMatrix result = btmp.lssolve (atmp, info, rank); typ = btyp.transpose (); - return result.hermitian (); } @@ -493,19 +383,8 @@ return Matrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - Matrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 2 -*- @@ -516,19 +395,8 @@ return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 3 -*- @@ -539,19 +407,8 @@ return SparseMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - SparseMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 4 -*- @@ -562,19 +419,8 @@ return SparseComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 5 -*- @@ -585,19 +431,8 @@ return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 6 -*- @@ -608,19 +443,8 @@ return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 7 -*- @@ -631,19 +455,8 @@ return SparseComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 8 -*- @@ -655,19 +468,8 @@ return SparseComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - SparseComplexMatrix result - = a.solve (typ, b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } /*
--- a/test/build_sparse_tests.sh Thu Mar 16 17:36:52 2006 +0000 +++ b/test/build_sparse_tests.sh Thu Mar 16 17:48:56 2006 +0000 @@ -935,7 +935,7 @@ %!test %! ds = alpha * spdiags([1:11]',0,10,11); %! df = full(ds); -%! xf = beta * ones(10,1); +%! xf = beta * ones(10,2); %! xs = speye(10,10); %!assert(ds\xf,df\xf,100*eps) %!assert(ds\xs,sparse(df\xs,true),100*eps) @@ -947,7 +947,7 @@ %!test %! ds = alpha * spdiags([1:11]',0,11,10); %! df = full(ds); -%! xf = beta * ones(11,1); +%! xf = beta * ones(11,2); %! xs = speye(11,11); %!assert(ds\xf,df\xf,100*eps) %!assert(ds\xs,sparse(df\xs,true),100*eps) @@ -971,18 +971,21 @@ %! assert(us\xf,r\c,100*eps) %!test %! [c,r] = spqr (us, xs); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(us\xs,r\c,100*eps) %!test %! pus = us(:,[1:8,10,9]); %!test %! [c,r] = spqr (pus, xf); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(pus\xf,r\c,100*eps) %!test %! [c,r] = spqr (pus, xs); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(pus\xs,r\c,100*eps) %!test %! ls = alpha*[speye(9,11);[1,sparse(1,8),1,0]]; -%! xf = beta * ones(10,1); +%! xf = beta * ones(10,2); %! xs = speye(10,10); %!assert(ls*(ls\xf),xf,100*eps) %!assert(ls*(ls\xs),xs,100*eps) @@ -992,21 +995,24 @@ %!assert(pls*(pls\xs),xs,100*eps) %!test %! ls = alpha*[speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]; -%! xf = beta * ones(12,1); +%! xf = beta * ones(12,2); %! xs = speye(12,12); %!test %! [c,r] = spqr (ls, xf); %! assert(ls\xf,r\c,100*eps) %!test %! [c,r] = spqr (ls, xs); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(ls\xs,r\c,100*eps) %!test %! pls = ls(:,[1:8,10,9]); %!test %! [c,r] = spqr (pls, xf); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(pls\xf,r\c,100*eps) %!test %! [c,r] = spqr (pls, xs); +%! r = matrix_type(r,"Singular"); ## Force Matrix Type %! assert(pls\xs,r\c,100*eps) EOF