Mercurial > hg > octave-lyh
changeset 10314:07ebe522dac2
untabify liboctave C++ sources
line wrap: on
line diff
--- a/liboctave/Array-C.cc +++ b/liboctave/Array-C.cc @@ -45,18 +45,18 @@ nan_ascending_compare (const Complex& x, const Complex& y) { return (xisnan (y) - ? ! xisnan (x) - : ((std::abs (x) < std::abs (x)) - || ((std::abs (x) == std::abs (x)) && (arg (x) < arg (x))))); + ? ! xisnan (x) + : ((std::abs (x) < std::abs (x)) + || ((std::abs (x) == std::abs (x)) && (arg (x) < arg (x))))); } static bool nan_descending_compare (const Complex& x, const Complex& y) { return (xisnan (x) - ? ! xisnan (y) - : ((std::abs (x) > std::abs (x)) - || ((std::abs (x) == std::abs (x)) && (arg (x) > arg (x))))); + ? ! xisnan (y) + : ((std::abs (x) > std::abs (x)) + || ((std::abs (x) == std::abs (x)) && (arg (x) > arg (x))))); } Array<Complex>::compare_fcn_type
--- a/liboctave/Array-fC.cc +++ b/liboctave/Array-fC.cc @@ -45,23 +45,23 @@ nan_ascending_compare (const FloatComplex& x, const FloatComplex& y) { return (xisnan (y) - ? ! xisnan (x) - : ((std::abs (x) < std::abs (x)) - || ((std::abs (x) == std::abs (x)) && (arg (x) < arg (x))))); + ? ! xisnan (x) + : ((std::abs (x) < std::abs (x)) + || ((std::abs (x) == std::abs (x)) && (arg (x) < arg (x))))); } static bool nan_descending_compare (const FloatComplex& x, const FloatComplex& y) { return (xisnan (x) - ? ! xisnan (y) - : ((std::abs (x) > std::abs (x)) - || ((std::abs (x) == std::abs (x)) && (arg (x) > arg (x))))); + ? ! xisnan (y) + : ((std::abs (x) > std::abs (x)) + || ((std::abs (x) == std::abs (x)) && (arg (x) > arg (x))))); } Array<FloatComplex>::compare_fcn_type safe_comparator (sortmode mode, const Array<FloatComplex>& a, - bool allow_chk) + bool allow_chk) { Array<FloatComplex>::compare_fcn_type result = 0;
--- a/liboctave/Array-util.cc +++ b/liboctave/Array-util.cc @@ -32,7 +32,7 @@ bool index_in_bounds (const Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { bool retval = true; @@ -41,13 +41,13 @@ if (n == dimensions.length ()) { for (int i = 0; i < n; i++) - { - if (ra_idx(i) < 0 || ra_idx(i) >= dimensions(i)) - { - retval = false; - break; - } - } + { + if (ra_idx(i) < 0 || ra_idx(i) >= dimensions(i)) + { + retval = false; + break; + } + } } else retval = false; @@ -57,7 +57,7 @@ void increment_index (Array<octave_idx_type>& ra_idx, const dim_vector& dimensions, - int start_dimension) + int start_dimension) { ra_idx(start_dimension)++; @@ -67,12 +67,12 @@ for (int i = start_dimension; i < n; i++) { if (ra_idx(i) < (i < nda ? dimensions(i) : 1)) - break; + break; else - { - ra_idx(i) = 0; - ra_idx(i+1)++; - } + { + ra_idx(i) = 0; + ra_idx(i+1)++; + } } } @@ -88,11 +88,11 @@ retval = idx(--n); while (--n >= 0) - { - retval *= dims (n); - - retval += idx(n); - } + { + retval *= dims (n); + + retval += idx(n); + } } return retval; } @@ -105,7 +105,7 @@ for (octave_idx_type i = 0; i < ra_idx.length (); i++) { if (ra_idx (i) == 1) - retval++; + retval++; } return retval; @@ -125,14 +125,14 @@ else { for (int i = 0; i < n; i ++) - { - if (dim (i) != 1) - { - retval = false; - - break; - } - } + { + if (dim (i) != 1) + { + retval = false; + + break; + } + } } return retval; } @@ -148,10 +148,10 @@ else { for (int i = 0; i < n; i ++) - if (dim (i) > 1) - m++; - else if (dim(i) < 1) - m += 2; + if (dim (i) > 1) + m++; + else if (dim(i) < 1) + m += 2; } return (m < 2); @@ -165,11 +165,11 @@ for (octave_idx_type i = 0; i < arr.length (); i++) { if (arr (i) == 1) - { - retval = true; - - break; - } + { + retval = true; + + break; + } } return retval; } @@ -186,11 +186,11 @@ retval = ra_idx(--n); while (--n >= 0) - { - retval *= dims(n); - - retval += ra_idx(n); - } + { + retval *= dims(n); + + retval += ra_idx(n); + } } else (*current_liboctave_error_handler) @@ -236,7 +236,7 @@ for (int i = 0; i < n; i++) retval(i) = ra_idx(i).freeze (dimensions(i), tag[i < 2 ? i : 3], - resize_ok); + resize_ok); return retval; } @@ -252,11 +252,11 @@ { if (dv(i) != 1) { - if (! found_first) - found_first = true; - else - return false; - } + if (! found_first) + found_first = true; + else + return false; + } } return true; @@ -272,10 +272,10 @@ for (octave_idx_type i = 0; i < n; i++) { if (! ra_idx(i)) - { - retval = false; - break; - } + { + retval = false; + break; + } } return retval; @@ -291,10 +291,10 @@ for (octave_idx_type i = 0; i < n; i++) { if (ra_idx(i).orig_empty ()) - { - retval = true; - break; - } + { + retval = true; + break; + } } return retval; @@ -302,7 +302,7 @@ bool all_colon_equiv (const Array<idx_vector>& ra_idx, - const dim_vector& frozen_lengths) + const dim_vector& frozen_lengths) { bool retval = true; @@ -315,10 +315,10 @@ for (octave_idx_type i = 0; i < n; i++) { if (! ra_idx(i).is_colon_equiv (frozen_lengths(i))) - { - retval = false; - break; - } + { + retval = false; + break; + } } return retval; @@ -332,10 +332,10 @@ for (octave_idx_type i = 0; i < arr.length (); i++) { if (arr(i) != 1) - { - retval = false; - break; - } + { + retval = false; + break; + } } return retval; @@ -343,7 +343,7 @@ Array<octave_idx_type> get_elt_idx (const Array<idx_vector>& ra_idx, - const Array<octave_idx_type>& result_idx) + const Array<octave_idx_type>& result_idx) { octave_idx_type n = ra_idx.length (); @@ -380,7 +380,7 @@ for (int i = 0; i < n_dims; i++) { std::cout << "idx: " << idx << ", var: " << var - << ", dims(" << i << "): " << dims(i) <<"\n"; + << ", dims(" << i << "): " << dims(i) <<"\n"; retval(i) = ((int)floor(((idx) / (double)var))) % dims(i); idx -= var * retval(i); var = dims(i); @@ -447,7 +447,7 @@ dim_vector zero_dims_inquire (const idx_vector& i, const idx_vector& j, - const dim_vector& rhdv) + const dim_vector& rhdv) { bool icol = i.is_colon (), jcol = j.is_colon (); dim_vector rdv; @@ -633,7 +633,7 @@ void gripe_nonconformant (const char *op, int op1_nr, int op1_nc, - int op2_nr, int op2_nc) + int op2_nr, int op2_nc) { (*current_liboctave_error_handler) ("%s: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", @@ -642,7 +642,7 @@ void gripe_nonconformant (const char *op, dim_vector& op1_dims, - dim_vector& op2_dims) + dim_vector& op2_dims) { std::string op1_dims_str = op1_dims.str (); std::string op2_dims_str = op2_dims.str ();
--- a/liboctave/Array.cc +++ b/liboctave/Array.cc @@ -126,37 +126,37 @@ int k = 0; for (int i = 0; i < ndims (); i++) - { - if (dimensions(i) == 1) - dims_changed = true; - else - new_dimensions(k++) = dimensions(i); - } + { + if (dimensions(i) == 1) + dims_changed = true; + else + new_dimensions(k++) = dimensions(i); + } if (dims_changed) - { - switch (k) - { - case 0: - new_dimensions = dim_vector (1, 1); - break; - - case 1: - { - octave_idx_type tmp = new_dimensions(0); - - new_dimensions.resize (2); - - new_dimensions(0) = tmp; - new_dimensions(1) = 1; - } - break; - - default: - new_dimensions.resize (k); - break; - } - } + { + switch (k) + { + case 0: + new_dimensions = dim_vector (1, 1); + break; + + case 1: + { + octave_idx_type tmp = new_dimensions(0); + + new_dimensions.resize (2); + + new_dimensions(0) = tmp; + new_dimensions(1) = 1; + } + break; + + default: + new_dimensions.resize (k); + break; + } + } retval = Array<T> (*this, new_dimensions); } @@ -448,22 +448,22 @@ { octave_idx_type perm_elt = perm_vec.elem (i); if (perm_elt >= perm_vec_len || perm_elt < 0) - { - (*current_liboctave_error_handler) - ("%s: permutation vector contains an invalid element", - inv ? "ipermute" : "permute"); - - return retval; - } + { + (*current_liboctave_error_handler) + ("%s: permutation vector contains an invalid element", + inv ? "ipermute" : "permute"); + + return retval; + } if (checked[perm_elt]) - { - (*current_liboctave_error_handler) - ("%s: permutation vector cannot contain identical elements", - inv ? "ipermute" : "permute"); - - return retval; - } + { + (*current_liboctave_error_handler) + ("%s: permutation vector cannot contain identical elements", + inv ? "ipermute" : "permute"); + + return retval; + } else { checked[perm_elt] = true; @@ -1190,7 +1190,7 @@ octave_idx_type il = i.length (rdv(0)), jl = j.length (rdv(1)); rhdv.chop_all_singletons (); bool match = (isfill - || (rhdv.length () == 2 && il == rhdv(0) && jl == rhdv(1))); + || (rhdv.length () == 2 && il == rhdv(0) && jl == rhdv(1))); match = match || (il == 1 && jl == rhdv(0) && rhdv(1) == 1); if (match) @@ -1555,8 +1555,8 @@ Array<T> result (dim_vector (nc, nr)); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - result.xelem (j, i) = xelem (i, j); + for (octave_idx_type i = 0; i < nr; i++) + result.xelem (j, i) = xelem (i, j); return result; } @@ -1598,32 +1598,32 @@ octave_idx_type ii = 0, jj; for (jj = 0; jj < (nc - 8 + 1); jj += 8) - { - for (ii = 0; ii < (nr - 8 + 1); ii += 8) - { - // Copy to buffer - for (octave_idx_type j = jj, k = 0, idxj = jj * nr; - j < jj + 8; j++, idxj += nr) - for (octave_idx_type i = ii; i < ii + 8; i++) - buf[k++] = xelem (i + idxj); - - // Copy from buffer - for (octave_idx_type i = ii, idxi = ii * nc; i < ii + 8; - i++, idxi += nc) - for (octave_idx_type j = jj, k = i - ii; j < jj + 8; - j++, k+=8) - result.xelem (j + idxi) = fcn (buf[k]); - } - - if (ii < nr) - for (octave_idx_type j = jj; j < jj + 8; j++) - for (octave_idx_type i = ii; i < nr; i++) - result.xelem (j, i) = fcn (xelem (i, j)); - } + { + for (ii = 0; ii < (nr - 8 + 1); ii += 8) + { + // Copy to buffer + for (octave_idx_type j = jj, k = 0, idxj = jj * nr; + j < jj + 8; j++, idxj += nr) + for (octave_idx_type i = ii; i < ii + 8; i++) + buf[k++] = xelem (i + idxj); + + // Copy from buffer + for (octave_idx_type i = ii, idxi = ii * nc; i < ii + 8; + i++, idxi += nc) + for (octave_idx_type j = jj, k = i - ii; j < jj + 8; + j++, k+=8) + result.xelem (j + idxi) = fcn (buf[k]); + } + + if (ii < nr) + for (octave_idx_type j = jj; j < jj + 8; j++) + for (octave_idx_type i = ii; i < nr; i++) + result.xelem (j, i) = fcn (xelem (i, j)); + } for (octave_idx_type j = jj; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - result.xelem (j, i) = fcn (xelem (i, j)); + for (octave_idx_type i = 0; i < nr; i++) + result.xelem (j, i) = fcn (xelem (i, j)); return result; } @@ -1632,8 +1632,8 @@ Array<T> result (dim_vector (nc, nr)); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - result.xelem (j, i) = fcn (xelem (i, j)); + for (octave_idx_type i = 0; i < nr; i++) + result.xelem (j, i) = fcn (xelem (i, j)); return result; } @@ -1697,14 +1697,14 @@ if (delete_dims) { if (dimensions(i) != 1) - { - delete_dims = false; - - new_dims = dim_vector (i + 1, dimensions(i)); - } + { + delete_dims = false; + + new_dims = dim_vector (i + 1, dimensions(i)); + } } else - new_dims(i) = dimensions(i); + new_dims(i) = dimensions(i); } if (nd != new_dims.length ()) @@ -1757,7 +1757,7 @@ if (stride == 1) { for (octave_idx_type j = 0; j < iter; j++) - { + { // copy and partition out NaNs. // FIXME: impact on integer types noticeable? octave_idx_type kl = 0, ku = ns; @@ -1771,7 +1771,7 @@ } // sort. - lsort.sort (v, kl); + lsort.sort (v, kl); if (ku < ns) { @@ -1781,27 +1781,27 @@ std::rotate (v, v + ku, v + ns); } - v += ns; + v += ns; ov += ns; - } + } } else { OCTAVE_LOCAL_BUFFER (T, buf, ns); for (octave_idx_type j = 0; j < iter; j++) - { - octave_idx_type offset = j; - octave_idx_type offset2 = 0; - - while (offset >= stride) - { - offset -= stride; - offset2++; - } - - offset += offset2 * stride * ns; - + { + octave_idx_type offset = j; + octave_idx_type offset2 = 0; + + while (offset >= stride) + { + offset -= stride; + offset2++; + } + + offset += offset2 * stride * ns; + // gather and partition out NaNs. // FIXME: impact on integer types noticeable? octave_idx_type kl = 0, ku = ns; @@ -1815,7 +1815,7 @@ } // sort. - lsort.sort (buf, kl); + lsort.sort (buf, kl); if (ku < ns) { @@ -1826,9 +1826,9 @@ } // scatter. - for (octave_idx_type i = 0; i < ns; i++) - v[i*stride + offset] = buf[i]; - } + for (octave_idx_type i = 0; i < ns; i++) + v[i*stride + offset] = buf[i]; + } } return m; @@ -1837,7 +1837,7 @@ template <class T> Array<T> Array<T>::sort (Array<octave_idx_type> &sidx, int dim, - sortmode mode) const + sortmode mode) const { if (dim < 0 || dim >= ndims ()) { @@ -1879,7 +1879,7 @@ if (stride == 1) { for (octave_idx_type j = 0; j < iter; j++) - { + { // copy and partition out NaNs. // FIXME: impact on integer types noticeable? octave_idx_type kl = 0, ku = ns; @@ -1901,7 +1901,7 @@ } // sort. - lsort.sort (v, vi, kl); + lsort.sort (v, vi, kl); if (ku < ns) { @@ -1915,10 +1915,10 @@ } } - v += ns; + v += ns; vi += ns; ov += ns; - } + } } else { @@ -1926,18 +1926,18 @@ OCTAVE_LOCAL_BUFFER (octave_idx_type, bufi, ns); for (octave_idx_type j = 0; j < iter; j++) - { - octave_idx_type offset = j; - octave_idx_type offset2 = 0; - - while (offset >= stride) - { - offset -= stride; - offset2++; - } - - offset += offset2 * stride * ns; - + { + octave_idx_type offset = j; + octave_idx_type offset2 = 0; + + while (offset >= stride) + { + offset -= stride; + offset2++; + } + + offset += offset2 * stride * ns; + // gather and partition out NaNs. // FIXME: impact on integer types noticeable? octave_idx_type kl = 0, ku = ns; @@ -1959,7 +1959,7 @@ } // sort. - lsort.sort (buf, bufi, kl); + lsort.sort (buf, bufi, kl); if (ku < ns) { @@ -1974,11 +1974,11 @@ } // scatter. - for (octave_idx_type i = 0; i < ns; i++) - v[i*stride + offset] = buf[i]; - for (octave_idx_type i = 0; i < ns; i++) - vi[i*stride + offset] = bufi[i]; - } + for (octave_idx_type i = 0; i < ns; i++) + v[i*stride + offset] = buf[i]; + for (octave_idx_type i = 0; i < ns; i++) + vi[i*stride + offset] = bufi[i]; + } } return m; @@ -2012,7 +2012,7 @@ { // Auto-detect mode. compare_fcn_type compare - = safe_comparator (ASCENDING, *this, false); + = safe_comparator (ASCENDING, *this, false); if (compare (elem (n-1), elem (0))) mode = DESCENDING; @@ -2065,7 +2065,7 @@ { // Auto-detect mode. compare_fcn_type compare - = safe_comparator (ASCENDING, *this, false); + = safe_comparator (ASCENDING, *this, false); octave_idx_type i; for (i = 0; i < cols (); i++) @@ -2478,72 +2478,72 @@ octave_idx_type nnc = dv (1); if (nnr == 0 || nnc == 0) - ; // do nothing + ; // do nothing else if (nnr != 1 && nnc != 1) - { - if (k > 0) - nnc -= k; - else if (k < 0) - nnr += k; - - if (nnr > 0 && nnc > 0) - { - octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; - - d.resize (dim_vector (ndiag, 1)); - - if (k > 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - d.xelem (i) = elem (i, i+k); - } - else if (k < 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - d.xelem (i) = elem (i-k, i); - } - else - { - for (octave_idx_type i = 0; i < ndiag; i++) - d.xelem (i) = elem (i, i); - } - } - else - (*current_liboctave_error_handler) - ("diag: requested diagonal out of range"); - } + { + if (k > 0) + nnc -= k; + else if (k < 0) + nnr += k; + + if (nnr > 0 && nnc > 0) + { + octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; + + d.resize (dim_vector (ndiag, 1)); + + if (k > 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + d.xelem (i) = elem (i, i+k); + } + else if (k < 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + d.xelem (i) = elem (i-k, i); + } + else + { + for (octave_idx_type i = 0; i < ndiag; i++) + d.xelem (i) = elem (i, i); + } + } + else + (*current_liboctave_error_handler) + ("diag: requested diagonal out of range"); + } else if (nnr != 0 && nnc != 0) - { - octave_idx_type roff = 0; - octave_idx_type coff = 0; - if (k > 0) - { - roff = 0; - coff = k; - } - else if (k < 0) - { - roff = -k; - coff = 0; - } - - if (nnr == 1) - { - octave_idx_type n = nnc + std::abs (k); - d = Array<T> (dim_vector (n, n), resize_fill_value ()); - - for (octave_idx_type i = 0; i < nnc; i++) - d.xelem (i+roff, i+coff) = elem (0, i); - } - else - { - octave_idx_type n = nnr + std::abs (k); - d = Array<T> (dim_vector (n, n), resize_fill_value ()); - - for (octave_idx_type i = 0; i < nnr; i++) - d.xelem (i+roff, i+coff) = elem (i, 0); - } - } + { + octave_idx_type roff = 0; + octave_idx_type coff = 0; + if (k > 0) + { + roff = 0; + coff = k; + } + else if (k < 0) + { + roff = -k; + coff = 0; + } + + if (nnr == 1) + { + octave_idx_type n = nnc + std::abs (k); + d = Array<T> (dim_vector (n, n), resize_fill_value ()); + + for (octave_idx_type i = 0; i < nnc; i++) + d.xelem (i+roff, i+coff) = elem (0, i); + } + else + { + octave_idx_type n = nnr + std::abs (k); + d = Array<T> (dim_vector (n, n), resize_fill_value ()); + + for (octave_idx_type i = 0; i < nnr; i++) + d.xelem (i+roff, i+coff) = elem (i, 0); + } + } } return d; @@ -2605,7 +2605,7 @@ octave_idx_type m = 1; for (int i = 2; i < n_dims; i++) - m *= a_dims(i); + m *= a_dims(i); if (m == 1) { @@ -2614,32 +2614,32 @@ switch (n_dims) { - case 2: - rows = a_dims(0); - cols = a_dims(1); - - for (octave_idx_type j = 0; j < rows; j++) - { - ra_idx(0) = j; - for (octave_idx_type k = 0; k < cols; k++) - { - ra_idx(1) = k; - os << " " << a.elem(ra_idx); - } - os << "\n"; - } - break; - - default: - rows = a_dims(0); - - for (octave_idx_type k = 0; k < rows; k++) - { - ra_idx(0) = k; - os << " " << a.elem(ra_idx); - } - break; - } + case 2: + rows = a_dims(0); + cols = a_dims(1); + + for (octave_idx_type j = 0; j < rows; j++) + { + ra_idx(0) = j; + for (octave_idx_type k = 0; k < cols; k++) + { + ra_idx(1) = k; + os << " " << a.elem(ra_idx); + } + os << "\n"; + } + break; + + default: + rows = a_dims(0); + + for (octave_idx_type k = 0; k < rows; k++) + { + ra_idx(0) = k; + os << " " << a.elem(ra_idx); + } + break; + } os << "\n"; } @@ -2653,27 +2653,27 @@ os << "\n(:,:,"; for (int j = 2; j < n_dims - 1; j++) - os << ra_idx(j) + 1 << ","; - - os << ra_idx(n_dims - 1) + 1 << ") = \n"; - - for (octave_idx_type j = 0; j < rows; j++) - { - ra_idx(0) = j; - - for (octave_idx_type k = 0; k < cols; k++) - { - ra_idx(1) = k; - os << " " << a.elem(ra_idx); - } - - os << "\n"; - } - - os << "\n"; - - if (i != m - 1) - increment_index (ra_idx, a_dims, 2); + os << ra_idx(j) + 1 << ","; + + os << ra_idx(n_dims - 1) + 1 << ") = \n"; + + for (octave_idx_type j = 0; j < rows; j++) + { + ra_idx(0) = j; + + for (octave_idx_type k = 0; k < cols; k++) + { + ra_idx(1) = k; + os << " " << a.elem(ra_idx); + } + + os << "\n"; + } + + os << "\n"; + + if (i != m - 1) + increment_index (ra_idx, a_dims, 2); } } }
--- a/liboctave/CColVector.cc +++ b/liboctave/CColVector.cc @@ -42,10 +42,10 @@ { F77_RET_T F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const Complex&, - const Complex*, const octave_idx_type&, const Complex*, - const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const Complex&, + const Complex*, const octave_idx_type&, const Complex*, + const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); } // Complex Column Vector class @@ -90,7 +90,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i) = a.elem (i); + xelem (r+i) = a.elem (i); } return *this; @@ -112,7 +112,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i) = a.elem (i); + xelem (r+i) = a.elem (i); } return *this; @@ -128,7 +128,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -144,7 +144,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } @@ -169,7 +169,7 @@ make_unique (); for (octave_idx_type i = r1; i <= r2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -193,7 +193,7 @@ make_unique (); for (octave_idx_type i = r1; i <= r2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -466,8 +466,8 @@ for (octave_idx_type i = 1; i < len; i++) if (std::abs (elem (i)) < absres) { - res = elem (i); - absres = std::abs (res); + res = elem (i); + absres = std::abs (res); } return res; @@ -486,8 +486,8 @@ for (octave_idx_type i = 1; i < len; i++) if (std::abs (elem (i)) > absres) { - res = elem (i); - absres = std::abs (res); + res = elem (i); + absres = std::abs (res); } return res;
--- a/liboctave/CDiagMatrix.cc +++ b/liboctave/CDiagMatrix.cc @@ -250,7 +250,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = ComplexDiagMatrix (mx_inline_conj_dup (a.data (), a_len), - a.rows (), a.cols ()); + a.rows (), a.cols ()); return retval; } @@ -378,12 +378,12 @@ for (octave_idx_type i = 0; i < length (); i++) { if (elem (i, i) == 0.0) - { - info = -1; - return *this; - } + { + info = -1; + return *this; + } else - retval.elem (i, i) = 1.0 / elem (i, i); + retval.elem (i, i) = 1.0 / elem (i, i); } return retval; @@ -570,12 +570,12 @@ for (octave_idx_type i = 0; i < a.rows (); i++) { for (octave_idx_type j = 0; j < a.cols (); j++) - { - if (i == j) - os << " " /* setw (field_width) */ << a.elem (i, i); - else - os << " " /* setw (field_width) */ << ZERO; - } + { + if (i == j) + os << " " /* setw (field_width) */ << a.elem (i, i); + else + os << " " /* setw (field_width) */ << ZERO; + } os << "\n"; } return os;
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -66,35 +66,35 @@ { F77_RET_T F77_FUNC (xilaenv, XILAENV) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, + const octave_idx_type&, const octave_idx_type&, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, + const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgemm, ZGEMM) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const Complex&, const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, const Complex&, - Complex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + const Complex&, const Complex*, const octave_idx_type&, + const Complex*, const octave_idx_type&, const Complex&, + Complex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, @@ -105,127 +105,127 @@ F77_RET_T F77_FUNC (xzdotu, XZDOTU) (const octave_idx_type&, const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, Complex&); + const Complex*, const octave_idx_type&, Complex&); F77_RET_T F77_FUNC (xzdotc, XZDOTC) (const octave_idx_type&, const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, Complex&); + const Complex*, const octave_idx_type&, Complex&); F77_RET_T F77_FUNC (zsyrk, ZSYRK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const Complex&, const Complex*, const octave_idx_type&, - const Complex&, Complex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, + const Complex&, const Complex*, const octave_idx_type&, + const Complex&, Complex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zherk, ZHERK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const double&, const Complex*, const octave_idx_type&, - const double&, Complex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, + const double&, const Complex*, const octave_idx_type&, + const double&, Complex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgetrf, ZGETRF) (const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, - octave_idx_type*, octave_idx_type&); + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (zgetrs, ZGETRS) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, - const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, + const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgetri, ZGETRI) (const octave_idx_type&, Complex*, const octave_idx_type&, const octave_idx_type*, - Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zgecon, ZGECON) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, - const octave_idx_type&, const double&, double&, - Complex*, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, Complex*, + const octave_idx_type&, const double&, double&, + Complex*, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgelsy, ZGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, - Complex*, const octave_idx_type&, double*, octave_idx_type&); + Complex*, const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, + Complex*, const octave_idx_type&, double*, octave_idx_type&); F77_RET_T F77_FUNC (zgelsd, ZGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, - const octave_idx_type&, double*, double&, octave_idx_type&, - Complex*, const octave_idx_type&, double*, - octave_idx_type*, octave_idx_type&); + Complex*, const octave_idx_type&, Complex*, + const octave_idx_type&, double*, double&, octave_idx_type&, + Complex*, const octave_idx_type&, double*, + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpocon, ZPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, const double&, - double&, Complex*, double*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, const double&, + double&, Complex*, double*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpotrs, ZPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const Complex*, - const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const Complex*, + const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ztrtri, ZTRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const Complex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ztrcon, ZTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const Complex*, const octave_idx_type&, double&, - Complex*, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const Complex*, const octave_idx_type&, double&, + Complex*, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ztrtrs, ZTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const Complex*, - const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const octave_idx_type&, const Complex*, + const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zlartg, ZLARTG) (const Complex&, const Complex&, - double&, Complex&, Complex&); + double&, Complex&, Complex&); F77_RET_T F77_FUNC (ztrsyl, ZTRSYL) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, double&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + const Complex*, const octave_idx_type&, + const Complex*, const octave_idx_type&, + const Complex*, const octave_idx_type&, double&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xzlange, XZLANGE) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const Complex*, - const octave_idx_type&, double*, double& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const Complex*, + const octave_idx_type&, double*, double& + F77_CHAR_ARG_LEN_DECL); } static const Complex Complex_NaN_result (octave_NaN, octave_NaN); @@ -332,9 +332,9 @@ if (is_square () && nr > 0) { for (octave_idx_type i = 0; i < nr; i++) - for (octave_idx_type j = i; j < nc; j++) - if (elem (i, j) != conj (elem (j, i))) - return false; + for (octave_idx_type j = i; j < nc; j++) + if (elem (i, j) != conj (elem (j, i))) + return false; return true; } @@ -361,8 +361,8 @@ make_unique (); for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = 0; i < a_nr; i++) - xelem (r+i, c+j) = a.elem (i, j); + for (octave_idx_type i = 0; i < a_nr; i++) + xelem (r+i, c+j) = a.elem (i, j); } return *this; @@ -384,7 +384,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r, c+i) = a.elem (i); + xelem (r, c+i) = a.elem (i); } return *this; @@ -406,7 +406,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i, c) = a.elem (i); + xelem (r+i, c) = a.elem (i); } return *this; @@ -433,7 +433,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i, c+i) = a.elem (i, i); + xelem (r+i, c+i) = a.elem (i, i); } return *this; @@ -478,7 +478,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i, c) = a.elem (i); + xelem (r+i, c) = a.elem (i); } return *this; @@ -505,7 +505,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (r+i, c+i) = a.elem (i, i); + xelem (r+i, c+i) = a.elem (i, i); } return *this; @@ -522,8 +522,8 @@ make_unique (); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - xelem (i, j) = val; + for (octave_idx_type i = 0; i < nr; i++) + xelem (i, j) = val; } return *this; @@ -540,8 +540,8 @@ make_unique (); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - xelem (i, j) = val; + for (octave_idx_type i = 0; i < nr; i++) + xelem (i, j) = val; } return *this; @@ -568,8 +568,8 @@ make_unique (); for (octave_idx_type j = c1; j <= c2; j++) - for (octave_idx_type i = r1; i <= r2; i++) - xelem (i, j) = val; + for (octave_idx_type i = r1; i <= r2; i++) + xelem (i, j) = val; } return *this; @@ -596,8 +596,8 @@ make_unique (); for (octave_idx_type j = c1; j <= c2; j++) - for (octave_idx_type i = r1; i <= r2; i++) - xelem (i, j) = val; + for (octave_idx_type i = r1; i <= r2; i++) + xelem (i, j) = val; } return *this; @@ -755,7 +755,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -774,7 +774,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -793,7 +793,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -812,7 +812,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -831,7 +831,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -850,7 +850,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -869,7 +869,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -888,7 +888,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -971,7 +971,7 @@ ComplexMatrix ComplexMatrix::inverse (octave_idx_type& info, double& rcon, int force, - int calc_cond) const + int calc_cond) const { MatrixType mattype (*this); return inverse (mattype, info, rcon, force, calc_cond); @@ -994,7 +994,7 @@ ComplexMatrix ComplexMatrix::tinverse (MatrixType &mattype, octave_idx_type& info, - double& rcon, int force, int calc_cond) const + double& rcon, int force, int calc_cond) const { ComplexMatrix retval; @@ -1012,38 +1012,38 @@ Complex *tmp_data = retval.fortran_vec (); F77_XFCN (ztrtri, ZTRTRI, (F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&udiag, 1), - nr, tmp_data, nr, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&udiag, 1), + nr, tmp_data, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); // Throw-away extra info LAPACK gives so as to not change output. rcon = 0.0; if (info != 0) - info = -1; + info = -1; else if (calc_cond) - { - octave_idx_type ztrcon_info = 0; - char job = '1'; - - OCTAVE_LOCAL_BUFFER (Complex, cwork, 2*nr); - OCTAVE_LOCAL_BUFFER (double, rwork, nr); - - F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&udiag, 1), - nr, tmp_data, nr, rcon, - cwork, rwork, ztrcon_info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (ztrcon_info != 0) - info = -1; - } + { + octave_idx_type ztrcon_info = 0; + char job = '1'; + + OCTAVE_LOCAL_BUFFER (Complex, cwork, 2*nr); + OCTAVE_LOCAL_BUFFER (double, rwork, nr); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&udiag, 1), + nr, tmp_data, nr, rcon, + cwork, rwork, ztrcon_info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (ztrcon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore matrix contents. + retval = *this; // Restore matrix contents. } return retval; @@ -1051,7 +1051,7 @@ ComplexMatrix ComplexMatrix::finverse (MatrixType &mattype, octave_idx_type& info, - double& rcon, int force, int calc_cond) const + double& rcon, int force, int calc_cond) const { ComplexMatrix retval; @@ -1074,7 +1074,7 @@ // Query the optimum work array size. F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, - z.fortran_vec (), lwork, info)); + z.fortran_vec (), lwork, info)); lwork = static_cast<octave_idx_type> (std::real(z(0))); lwork = (lwork < 2 *nc ? 2*nc : lwork); @@ -1086,45 +1086,45 @@ // Calculate the norm of the matrix, for later use. double anorm; if (calc_cond) - anorm = retval.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + anorm = retval.abs().sum().row(static_cast<octave_idx_type>(0)).max(); F77_XFCN (zgetrf, ZGETRF, (nc, nc, tmp_data, nr, pipvt, info)); // Throw-away extra info LAPACK gives so as to not change output. rcon = 0.0; if (info != 0) - info = -1; + info = -1; else if (calc_cond) - { - // Now calculate the condition number for non-singular matrix. - octave_idx_type zgecon_info = 0; - char job = '1'; - Array<double> rz (2 * nc); - double *prz = rz.fortran_vec (); - F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, prz, zgecon_info - F77_CHAR_ARG_LEN (1))); - - if (zgecon_info != 0) - info = -1; - } + { + // Now calculate the condition number for non-singular matrix. + octave_idx_type zgecon_info = 0; + char job = '1'; + Array<double> rz (2 * nc); + double *prz = rz.fortran_vec (); + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, prz, zgecon_info + F77_CHAR_ARG_LEN (1))); + + if (zgecon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore contents. + retval = *this; // Restore contents. else - { - octave_idx_type zgetri_info = 0; - - F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, zgetri_info)); - - if (zgetri_info != 0) - info = -1; - } + { + octave_idx_type zgetri_info = 0; + + F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, + pz, lwork, zgetri_info)); + + if (zgetri_info != 0) + info = -1; + } if (info != 0) - mattype.mark_as_rectangular(); + mattype.mark_as_rectangular(); } return retval; @@ -1132,7 +1132,7 @@ ComplexMatrix ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info, - double& rcon, int force, int calc_cond) const + double& rcon, int force, int calc_cond) const { int typ = mattype.type (false); ComplexMatrix ret; @@ -1145,25 +1145,25 @@ else { if (mattype.is_hermitian ()) - { - ComplexCHOL chol (*this, info, calc_cond); - if (info == 0) - { - if (calc_cond) - rcon = chol.rcond(); - else - rcon = 1.0; - ret = chol.inverse (); - } - else - mattype.mark_as_unsymmetric (); - } + { + ComplexCHOL chol (*this, info, calc_cond); + if (info == 0) + { + if (calc_cond) + rcon = chol.rcond(); + else + rcon = 1.0; + ret = chol.inverse (); + } + else + mattype.mark_as_unsymmetric (); + } if (!mattype.is_hermitian ()) - ret = finverse(mattype, info, rcon, force, calc_cond); + ret = finverse(mattype, info, rcon, force, calc_cond); if ((mattype.is_hermitian () || calc_cond) && rcon == 0.) - ret = ComplexMatrix (rows (), columns (), Complex (octave_Inf, 0.)); + ret = ComplexMatrix (rows (), columns (), Complex (octave_Inf, 0.)); } return ret; @@ -1189,9 +1189,9 @@ if (tol <= 0.0) { if (nr > nc) - tol = nr * sigma.elem (0) * DBL_EPSILON; + tol = nr * sigma.elem (0) * DBL_EPSILON; else - tol = nc * sigma.elem (0) * DBL_EPSILON; + tol = nc * sigma.elem (0) * DBL_EPSILON; } while (r >= 0 && sigma.elem (r) < tol) @@ -1457,12 +1457,12 @@ octave_quit (); for (octave_idx_type i = 0; i < npts; i++) - prow[i] = tmp_data[i*nr + j]; + prow[i] = tmp_data[i*nr + j]; F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); for (octave_idx_type i = 0; i < npts; i++) - tmp_data[i*nr + j] = prow[i]; + tmp_data[i*nr + j] = prow[i]; } return retval; @@ -1526,12 +1526,12 @@ octave_quit (); for (octave_idx_type i = 0; i < npts; i++) - prow[i] = tmp_data[i*nr + j]; + prow[i] = tmp_data[i*nr + j]; F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); for (octave_idx_type i = 0; i < npts; i++) - tmp_data[i*nr + j] = prow[i] / static_cast<double> (npts); + tmp_data[i*nr + j] = prow[i] / static_cast<double> (npts); } return retval; @@ -1564,7 +1564,7 @@ ComplexDET ComplexMatrix::determinant (MatrixType& mattype, octave_idx_type& info, double& rcon, - int calc_cond) const + int calc_cond) const { ComplexDET retval (1.0); @@ -1719,145 +1719,145 @@ int typ = mattype.type (); if (typ == MatrixType::Unknown) - typ = mattype.type (*this); + typ = mattype.type (*this); // Only calculate the condition number for LU/Cholesky if (typ == MatrixType::Upper) - { - const Complex *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, prz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0; - } + { + const Complex *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0; + } else if (typ == MatrixType::Permuted_Upper) - (*current_liboctave_error_handler) - ("permuted triangular matrix not implemented"); + (*current_liboctave_error_handler) + ("permuted triangular matrix not implemented"); else if (typ == MatrixType::Lower) - { - const Complex *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, prz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } + { + const Complex *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0.0; + } else if (typ == MatrixType::Permuted_Lower) - (*current_liboctave_error_handler) - ("permuted triangular matrix not implemented"); + (*current_liboctave_error_handler) + ("permuted triangular matrix not implemented"); else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) - { - double anorm = -1.0; - ComplexMatrix atmp = *this; - Complex *tmp_data = atmp.fortran_vec (); - - if (typ == MatrixType::Hermitian) - { - octave_idx_type info = 0; - char job = 'L'; - anorm = atmp.abs().sum(). - row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, - tmp_data, nr, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - { - rcon = 0.0; - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } - } - - - if (typ == MatrixType::Full) - { - octave_idx_type info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - if(anorm < 0.) - anorm = atmp.abs().sum(). - row(static_cast<octave_idx_type>(0)).max(); - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (2 * nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (info != 0) - { - rcon = 0.0; - mattype.mark_as_rectangular (); - } - else - { - char job = '1'; - F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } - } - } + { + double anorm = -1.0; + ComplexMatrix atmp = *this; + Complex *tmp_data = atmp.fortran_vec (); + + if (typ == MatrixType::Hermitian) + { + octave_idx_type info = 0; + char job = 'L'; + anorm = atmp.abs().sum(). + row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, + tmp_data, nr, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + { + rcon = 0.0; + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0.0; + } + } + + + if (typ == MatrixType::Full) + { + octave_idx_type info = 0; + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + if(anorm < 0.) + anorm = atmp.abs().sum(). + row(static_cast<octave_idx_type>(0)).max(); + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (2 * nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (info != 0) + { + rcon = 0.0; + mattype.mark_as_rectangular (); + } + else + { + char job = '1'; + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0.0; + } + } + } else - rcon = 0.0; + rcon = 0.0; } return rcon; @@ -1865,9 +1865,9 @@ ComplexMatrix ComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { ComplexMatrix retval; @@ -1884,81 +1884,81 @@ volatile int typ = mattype.type (); if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Upper) - { - octave_idx_type b_nc = b.cols (); - rcon = 1.; - info = 0; - - if (typ == MatrixType::Permuted_Upper) - { - (*current_liboctave_error_handler) - ("permuted triangular matrix not implemented"); - } - else - { - const Complex *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, prz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcon + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcon)) - { - info = -2; - - if (sing_handler) - sing_handler (rcon); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcon); - } - } - - if (info == 0) - { - retval = b; - Complex *result = retval.fortran_vec (); - - char uplo = 'U'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&trans, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, b_nc, tmp_data, nr, - result, nr, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - } - } - } + typ == MatrixType::Upper) + { + octave_idx_type b_nc = b.cols (); + rcon = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Upper) + { + (*current_liboctave_error_handler) + ("permuted triangular matrix not implemented"); + } + else + { + const Complex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcon + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcon)) + { + info = -2; + + if (sing_handler) + sing_handler (rcon); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcon); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + } + } + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1966,9 +1966,9 @@ ComplexMatrix ComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { ComplexMatrix retval; @@ -1985,81 +1985,81 @@ volatile int typ = mattype.type (); if (typ == MatrixType::Permuted_Lower || - typ == MatrixType::Lower) - { - octave_idx_type b_nc = b.cols (); - rcon = 1.; - info = 0; - - if (typ == MatrixType::Permuted_Lower) - { - (*current_liboctave_error_handler) - ("permuted triangular matrix not implemented"); - } - else - { - const Complex *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, prz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcon + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcon)) - { - info = -2; - - if (sing_handler) - sing_handler (rcon); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcon); - } - } - - if (info == 0) - { - retval = b; - Complex *result = retval.fortran_vec (); - - char uplo = 'L'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&trans, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, b_nc, tmp_data, nr, - result, nr, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - } - } - } + typ == MatrixType::Lower) + { + octave_idx_type b_nc = b.cols (); + rcon = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Lower) + { + (*current_liboctave_error_handler) + ("permuted triangular matrix not implemented"); + } + else + { + const Complex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcon + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcon)) + { + info = -2; + + if (sing_handler) + sing_handler (rcon); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcon); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + } + } + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -2067,9 +2067,9 @@ ComplexMatrix ComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2090,160 +2090,160 @@ double anorm = -1.; if (typ == MatrixType::Hermitian) - { - info = 0; - char job = 'L'; - ComplexMatrix atmp = *this; - Complex *tmp_data = atmp.fortran_vec (); - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, - tmp_data, nr, info - F77_CHAR_ARG_LEN (1))); - - // Throw-away extra info LAPACK gives so as to not change output. - rcon = 0.0; - if (info != 0) - { - info = -2; - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - if (calc_cond) - { - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (nc); - double *prz = rz.fortran_vec (); - - F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcon + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcon)) - { - info = -2; - - if (sing_handler) - sing_handler (rcon); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcon); - } - } - - if (info == 0) - { - retval = b; - Complex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (zpotrs, ZPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, b_nc, tmp_data, nr, - result, b.rows(), info - F77_CHAR_ARG_LEN (1))); - } - else - { - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - } - } + { + info = 0; + char job = 'L'; + ComplexMatrix atmp = *this; + Complex *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, + tmp_data, nr, info + F77_CHAR_ARG_LEN (1))); + + // Throw-away extra info LAPACK gives so as to not change output. + rcon = 0.0; + if (info != 0) + { + info = -2; + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + if (calc_cond) + { + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcon + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcon)) + { + info = -2; + + if (sing_handler) + sing_handler (rcon); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcon); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (zpotrs, ZPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + } + else + { + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + } + } if (typ == MatrixType::Full) - { - info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - ComplexMatrix atmp = *this; - Complex *tmp_data = atmp.fortran_vec (); - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (2 * nc); - double *prz = rz.fortran_vec (); - - // Calculate the norm of the matrix, for later use. - if (anorm < 0.) - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - // Throw-away extra info LAPACK gives so as to not change output. - rcon = 0.0; - if (info != 0) - { - info = -2; - - if (sing_handler) - sing_handler (rcon); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - - mattype.mark_as_rectangular (); - } - else - { - if (calc_cond) - { - // Now calculate the condition number for - // non-singular matrix. - char job = '1'; - F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcon + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcon)) - { - info = -2; - - if (sing_handler) - sing_handler (rcon); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcon); - } - } - - if (info == 0) - { - retval = b; - Complex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - char job = 'N'; - F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, b_nc, tmp_data, nr, - pipvt, result, b.rows(), info - F77_CHAR_ARG_LEN (1))); - } - else - mattype.mark_as_rectangular (); - } - } + { + info = 0; + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + ComplexMatrix atmp = *this; + Complex *tmp_data = atmp.fortran_vec (); + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (2 * nc); + double *prz = rz.fortran_vec (); + + // Calculate the norm of the matrix, for later use. + if (anorm < 0.) + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + // Throw-away extra info LAPACK gives so as to not change output. + rcon = 0.0; + if (info != 0) + { + info = -2; + + if (sing_handler) + sing_handler (rcon); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision"); + + mattype.mark_as_rectangular (); + } + else + { + if (calc_cond) + { + // Now calculate the condition number for + // non-singular matrix. + char job = '1'; + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcon + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcon)) + { + info = -2; + + if (sing_handler) + sing_handler (rcon); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcon); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + pipvt, result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + } + else + mattype.mark_as_rectangular (); + } + } } return retval; @@ -2259,7 +2259,7 @@ ComplexMatrix ComplexMatrix::solve (MatrixType &typ, const Matrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcon; return solve (typ, b, info, rcon, 0); @@ -2267,15 +2267,15 @@ ComplexMatrix ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (typ, b, info, rcon, 0); } ComplexMatrix ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, - double& rcon, solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + double& rcon, solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { ComplexMatrix tmp (b); return solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt); @@ -2291,7 +2291,7 @@ ComplexMatrix ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcon; return solve (typ, b, info, rcon, 0); @@ -2299,16 +2299,16 @@ ComplexMatrix ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, - octave_idx_type& info, double& rcon) const + octave_idx_type& info, double& rcon) const { return solve (typ, b, info, rcon, 0); } ComplexMatrix ComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { ComplexMatrix retval; int typ = mattype.type (); @@ -2353,7 +2353,7 @@ ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcon; return solve (typ, ComplexColumnVector (b), info, rcon, 0); @@ -2361,15 +2361,15 @@ ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, - octave_idx_type& info, double& rcon) const + octave_idx_type& info, double& rcon) const { return solve (typ, ComplexColumnVector (b), info, rcon, 0); } ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { return solve (typ, ComplexColumnVector (b), info, rcon, sing_handler, transt); } @@ -2384,7 +2384,7 @@ ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcon; return solve (typ, b, info, rcon, 0); @@ -2392,15 +2392,15 @@ ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, - octave_idx_type& info, double& rcon) const + octave_idx_type& info, double& rcon) const { return solve (typ, b, info, rcon, 0); } ComplexColumnVector ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, - octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + octave_idx_type& info, double& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { ComplexMatrix tmp (b); @@ -2430,7 +2430,7 @@ ComplexMatrix ComplexMatrix::solve (const Matrix& b, octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + solve_singularity_handler sing_handler, blas_trans_type transt) const { ComplexMatrix tmp (b); return solve (tmp, info, rcon, sing_handler, transt); @@ -2459,7 +2459,7 @@ ComplexMatrix ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + solve_singularity_handler sing_handler, blas_trans_type transt) const { MatrixType mattype (*this); return solve (mattype, b, info, rcon, sing_handler, true, transt); @@ -2482,15 +2482,15 @@ ComplexColumnVector ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (ComplexColumnVector (b), info, rcon, 0); } ComplexColumnVector ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, - double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + double& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { return solve (ComplexColumnVector (b), info, rcon, sing_handler, transt); } @@ -2512,15 +2512,15 @@ ComplexColumnVector ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (b, info, rcon, 0); } ComplexColumnVector ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, - double& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + double& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { MatrixType mattype (*this); return solve (mattype, b, info, rcon, sing_handler, transt); @@ -2545,7 +2545,7 @@ ComplexMatrix ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (ComplexMatrix (b), info, rank, rcon); @@ -2553,7 +2553,7 @@ ComplexMatrix ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info, - octave_idx_type& rank, double& rcon) const + octave_idx_type& rank, double& rcon) const { return lssolve (ComplexMatrix (b), info, rank, rcon); } @@ -2577,7 +2577,7 @@ ComplexMatrix ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (b, info, rank, rcon); @@ -2585,7 +2585,7 @@ ComplexMatrix ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank, double& rcon) const + octave_idx_type& rank, double& rcon) const { ComplexMatrix retval; @@ -2606,15 +2606,15 @@ rcon = -1.0; if (m != n) - { - retval = ComplexMatrix (maxmn, nrhs); - - for (octave_idx_type j = 0; j < nrhs; j++) - for (octave_idx_type i = 0; i < m; i++) - retval.elem (i, j) = b.elem (i, j); - } + { + retval = ComplexMatrix (maxmn, nrhs); + + for (octave_idx_type j = 0; j < nrhs; j++) + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i, j) = b.elem (i, j); + } else - retval = b; + retval = b; ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); @@ -2630,17 +2630,17 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), - F77_CONST_CHAR_ARG2 (" ", 1), - 0, 0, 0, 0, smlsiz - F77_CHAR_ARG_LEN (6) - F77_CHAR_ARG_LEN (1)); + F77_CONST_CHAR_ARG2 (" ", 1), + 0, 0, 0, 0, smlsiz + F77_CHAR_ARG_LEN (6) + F77_CHAR_ARG_LEN (1)); octave_idx_type mnthr; F77_FUNC (xilaenv, XILAENV) (6, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), - F77_CONST_CHAR_ARG2 (" ", 1), - m, n, nrhs, -1, mnthr - F77_CHAR_ARG_LEN (6) - F77_CHAR_ARG_LEN (1)); + F77_CONST_CHAR_ARG2 (" ", 1), + m, n, nrhs, -1, mnthr + F77_CHAR_ARG_LEN (6) + F77_CHAR_ARG_LEN (1)); // We compute the size of rwork and iwork because ZGELSD in // older versions of LAPACK does not return them on a query @@ -2654,72 +2654,72 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl) - + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); + + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); if (lrwork < 1) - lrwork = 1; + lrwork = 1; Array<double> rwork (lrwork); double *prwork = rwork.fortran_vec (); octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; if (liwork < 1) - liwork = 1; + liwork = 1; Array<octave_idx_type> iwork (liwork); octave_idx_type* piwork = iwork.fortran_vec (); F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, prwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, prwork, piwork, info)); // The workspace query is broken in at least LAPACK 3.0.0 // through 3.1.1 when n >= mnthr. The obtuse formula below // should provide sufficient workspace for ZGELSD to operate // efficiently. if (n >= mnthr) - { - octave_idx_type addend = m; - - if (2*m-4 > addend) - addend = 2*m-4; - - if (nrhs > addend) - addend = nrhs; - - if (n-3*m > addend) - addend = n-3*m; - - const octave_idx_type lworkaround = 4*m + m*m + addend; - - if (std::real (work(0)) < lworkaround) - work(0) = lworkaround; - } + { + octave_idx_type addend = m; + + if (2*m-4 > addend) + addend = 2*m-4; + + if (nrhs > addend) + addend = nrhs; + + if (n-3*m > addend) + addend = n-3*m; + + const octave_idx_type lworkaround = 4*m + m*m + addend; + + if (std::real (work(0)) < lworkaround) + work(0) = lworkaround; + } else if (m >= n) - { - octave_idx_type lworkaround = 2*m + m*nrhs; - - if (std::real (work(0)) < lworkaround) - work(0) = lworkaround; - } + { + octave_idx_type lworkaround = 2*m + m*nrhs; + + if (std::real (work(0)) < lworkaround) + work(0) = lworkaround; + } lwork = static_cast<octave_idx_type> (std::real (work(0))); work.resize (lwork); F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - prwork, piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + prwork, piwork, info)); if (rank < minmn) - (*current_liboctave_warning_handler) - ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", - m, n, rank, rcon); + (*current_liboctave_warning_handler) + ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", + m, n, rank, rcon); if (s.elem (0) == 0.0) - rcon = 0.0; + rcon = 0.0; else - rcon = s.elem (minmn - 1) / s.elem (0); + rcon = s.elem (minmn - 1) / s.elem (0); retval.resize (n, nrhs); } @@ -2746,7 +2746,7 @@ ComplexColumnVector ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (ComplexColumnVector (b), info, rank, rcon); @@ -2754,7 +2754,7 @@ ComplexColumnVector ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, double& rcon) const + octave_idx_type& rank, double& rcon) const { return lssolve (ComplexColumnVector (b), info, rank, rcon); } @@ -2778,7 +2778,7 @@ ComplexColumnVector ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (b, info, rank, rcon); @@ -2787,7 +2787,7 @@ ComplexColumnVector ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, double& rcon) const + octave_idx_type& rank, double& rcon) const { ComplexColumnVector retval; @@ -2808,14 +2808,14 @@ rcon = -1.0; if (m != n) - { - retval = ComplexColumnVector (maxmn); - - for (octave_idx_type i = 0; i < m; i++) - retval.elem (i) = b.elem (i); - } + { + retval = ComplexColumnVector (maxmn); + + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i) = b.elem (i); + } else - retval = b; + retval = b; ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); @@ -2831,10 +2831,10 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), - F77_CONST_CHAR_ARG2 (" ", 1), - 0, 0, 0, 0, smlsiz - F77_CHAR_ARG_LEN (6) - F77_CHAR_ARG_LEN (1)); + F77_CONST_CHAR_ARG2 (" ", 1), + 0, 0, 0, 0, smlsiz + F77_CHAR_ARG_LEN (6) + F77_CHAR_ARG_LEN (1)); // We compute the size of rwork and iwork because ZGELSD in // older versions of LAPACK does not return them on a query @@ -2848,24 +2848,24 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl) - + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); + + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); if (lrwork < 1) - lrwork = 1; + lrwork = 1; Array<double> rwork (lrwork); double *prwork = rwork.fortran_vec (); octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; if (liwork < 1) - liwork = 1; + liwork = 1; Array<octave_idx_type> iwork (liwork); octave_idx_type* piwork = iwork.fortran_vec (); F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, prwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, prwork, piwork, info)); lwork = static_cast<octave_idx_type> (std::real (work(0))); work.resize (lwork); @@ -2873,24 +2873,24 @@ iwork.resize (iwork(0)); F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - prwork, piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + prwork, piwork, info)); if (rank < minmn) - { - if (rank < minmn) - (*current_liboctave_warning_handler) - ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", - m, n, rank, rcon); - - if (s.elem (0) == 0.0) - rcon = 0.0; - else - rcon = s.elem (minmn - 1) / s.elem (0); - - retval.resize (n, nrhs); - } + { + if (rank < minmn) + (*current_liboctave_warning_handler) + ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", + m, n, rank, rcon); + + if (s.elem (0) == 0.0) + rcon = 0.0; + else + rcon = s.elem (minmn - 1) / s.elem (0); + + retval.resize (n, nrhs); + } } return retval; @@ -2927,11 +2927,11 @@ Complex *c = retval.fortran_vec (); F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 ("N", 1), - len, a_len, 1, 1.0, v.data (), len, - a.data (), 1, 0.0, c, len - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("N", 1), + len, a_len, 1, 1.0, v.data (), len, + a.data (), 1, 0.0, c, len + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); } return retval; @@ -3092,9 +3092,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - Complex val = elem (i, j); - if (xisnan (val)) - return true; + Complex val = elem (i, j); + if (xisnan (val)) + return true; } return false; @@ -3109,9 +3109,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - Complex val = elem (i, j); - if (xisinf (val) || xisnan (val)) - return true; + Complex val = elem (i, j); + if (xisinf (val) || xisnan (val)) + return true; } return false; @@ -3146,10 +3146,10 @@ min_val = r_val; if (i_val > max_val) - max_val = i_val; + max_val = i_val; if (i_val < max_val) - min_val = i_val; + min_val = i_val; } else return false; @@ -3157,25 +3157,25 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - Complex val = elem (i, j); - - double r_val = std::real (val); - double i_val = std::imag (val); - - if (r_val > max_val) - max_val = r_val; - - if (i_val > max_val) - max_val = i_val; - - if (r_val < min_val) - min_val = r_val; - - if (i_val < min_val) - min_val = i_val; - - if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) - return false; + Complex val = elem (i, j); + + double r_val = std::real (val); + double i_val = std::imag (val); + + if (r_val > max_val) + max_val = r_val; + + if (i_val > max_val) + max_val = i_val; + + if (r_val < min_val) + min_val = r_val; + + if (i_val < min_val) + min_val = i_val; + + if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) + return false; } return true; @@ -3190,16 +3190,16 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - Complex val = elem (i, j); - - double r_val = std::real (val); - double i_val = std::imag (val); - - if ((! (xisnan (r_val) || xisinf (r_val)) - && fabs (r_val) > FLT_MAX) - || (! (xisnan (i_val) || xisinf (i_val)) - && fabs (i_val) > FLT_MAX)) - return true; + Complex val = elem (i, j); + + double r_val = std::real (val); + double i_val = std::imag (val); + + if ((! (xisnan (r_val) || xisinf (r_val)) + && fabs (r_val) > FLT_MAX) + || (! (xisnan (i_val) || xisinf (i_val)) + && fabs (i_val) > FLT_MAX)) + return true; } return false; @@ -3272,13 +3272,13 @@ for (octave_idx_type j = 0; j < nc; j++) { if (std::imag (elem (i, j)) != 0.0) - { - retval = false; - break; - } + { + retval = false; + break; + } } - return retval; + return retval; } bool @@ -3291,13 +3291,13 @@ for (octave_idx_type i = 0; i < nr; i++) { if (std::imag (elem (i, j)) != 0.0) - { - retval = false; - break; - } + { + retval = false; + break; + } } - return retval; + return retval; } ComplexColumnVector @@ -3322,52 +3322,52 @@ for (octave_idx_type i = 0; i < nr; i++) { - bool real_only = row_is_real_only (i); - - octave_idx_type idx_j; - - Complex tmp_min; - - double abs_min = octave_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_min = elem (i, idx_j); - - if (! xisnan (tmp_min)) - { - abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); - break; - } - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - Complex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); - - if (abs_tmp < abs_min) - { - idx_j = j; - tmp_min = tmp; - abs_min = abs_tmp; - } - } - - if (xisnan (tmp_min)) - { - result.elem (i) = Complex_NaN_result; - idx_arg.elem (i) = 0; - } - else - { - result.elem (i) = tmp_min; - idx_arg.elem (i) = idx_j; - } + bool real_only = row_is_real_only (i); + + octave_idx_type idx_j; + + Complex tmp_min; + + double abs_min = octave_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_min = elem (i, idx_j); + + if (! xisnan (tmp_min)) + { + abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); + break; + } + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + Complex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); + + if (abs_tmp < abs_min) + { + idx_j = j; + tmp_min = tmp; + abs_min = abs_tmp; + } + } + + if (xisnan (tmp_min)) + { + result.elem (i) = Complex_NaN_result; + idx_arg.elem (i) = 0; + } + else + { + result.elem (i) = tmp_min; + idx_arg.elem (i) = idx_j; + } } } @@ -3396,52 +3396,52 @@ for (octave_idx_type i = 0; i < nr; i++) { - bool real_only = row_is_real_only (i); - - octave_idx_type idx_j; - - Complex tmp_max; - - double abs_max = octave_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_max = elem (i, idx_j); - - if (! xisnan (tmp_max)) - { - abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); - break; - } - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - Complex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); - - if (abs_tmp > abs_max) - { - idx_j = j; - tmp_max = tmp; - abs_max = abs_tmp; - } - } - - if (xisnan (tmp_max)) - { - result.elem (i) = Complex_NaN_result; - idx_arg.elem (i) = 0; - } - else - { - result.elem (i) = tmp_max; - idx_arg.elem (i) = idx_j; - } + bool real_only = row_is_real_only (i); + + octave_idx_type idx_j; + + Complex tmp_max; + + double abs_max = octave_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_max = elem (i, idx_j); + + if (! xisnan (tmp_max)) + { + abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); + break; + } + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + Complex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); + + if (abs_tmp > abs_max) + { + idx_j = j; + tmp_max = tmp; + abs_max = abs_tmp; + } + } + + if (xisnan (tmp_max)) + { + result.elem (i) = Complex_NaN_result; + idx_arg.elem (i) = 0; + } + else + { + result.elem (i) = tmp_max; + idx_arg.elem (i) = idx_j; + } } } @@ -3470,52 +3470,52 @@ for (octave_idx_type j = 0; j < nc; j++) { - bool real_only = column_is_real_only (j); - - octave_idx_type idx_i; - - Complex tmp_min; - - double abs_min = octave_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_min = elem (idx_i, j); - - if (! xisnan (tmp_min)) - { - abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); - break; - } - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - Complex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); - - if (abs_tmp < abs_min) - { - idx_i = i; - tmp_min = tmp; - abs_min = abs_tmp; - } - } - - if (xisnan (tmp_min)) - { - result.elem (j) = Complex_NaN_result; - idx_arg.elem (j) = 0; - } - else - { - result.elem (j) = tmp_min; - idx_arg.elem (j) = idx_i; - } + bool real_only = column_is_real_only (j); + + octave_idx_type idx_i; + + Complex tmp_min; + + double abs_min = octave_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_min = elem (idx_i, j); + + if (! xisnan (tmp_min)) + { + abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); + break; + } + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + Complex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); + + if (abs_tmp < abs_min) + { + idx_i = i; + tmp_min = tmp; + abs_min = abs_tmp; + } + } + + if (xisnan (tmp_min)) + { + result.elem (j) = Complex_NaN_result; + idx_arg.elem (j) = 0; + } + else + { + result.elem (j) = tmp_min; + idx_arg.elem (j) = idx_i; + } } } @@ -3544,52 +3544,52 @@ for (octave_idx_type j = 0; j < nc; j++) { - bool real_only = column_is_real_only (j); - - octave_idx_type idx_i; - - Complex tmp_max; - - double abs_max = octave_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_max = elem (idx_i, j); - - if (! xisnan (tmp_max)) - { - abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); - break; - } - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - Complex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); - - if (abs_tmp > abs_max) - { - idx_i = i; - tmp_max = tmp; - abs_max = abs_tmp; - } - } - - if (xisnan (tmp_max)) - { - result.elem (j) = Complex_NaN_result; - idx_arg.elem (j) = 0; - } - else - { - result.elem (j) = tmp_max; - idx_arg.elem (j) = idx_i; - } + bool real_only = column_is_real_only (j); + + octave_idx_type idx_i; + + Complex tmp_max; + + double abs_max = octave_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_max = elem (idx_i, j); + + if (! xisnan (tmp_max)) + { + abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); + break; + } + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + Complex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); + + if (abs_tmp > abs_max) + { + idx_i = i; + tmp_max = tmp; + abs_max = abs_tmp; + } + } + + if (xisnan (tmp_max)) + { + result.elem (j) = Complex_NaN_result; + idx_arg.elem (j) = 0; + } + else + { + result.elem (j) = tmp_max; + idx_arg.elem (j) = idx_i; + } } } @@ -3604,10 +3604,10 @@ for (octave_idx_type i = 0; i < a.rows (); i++) { for (octave_idx_type j = 0; j < a.cols (); j++) - { - os << " "; - octave_write_complex (os, a.elem (i, j)); - } + { + os << " "; + octave_write_complex (os, a.elem (i, j)); + } os << "\n"; } return os; @@ -3623,14 +3623,14 @@ { Complex tmp; for (octave_idx_type i = 0; i < nr; i++) - for (octave_idx_type j = 0; j < nc; j++) - { - tmp = octave_read_value<Complex> (is); - if (is) - a.elem (i, j) = tmp; - else - goto done; - } + for (octave_idx_type j = 0; j < nc; j++) + { + tmp = octave_read_value<Complex> (is); + if (is) + a.elem (i, j) = tmp; + else + goto done; + } } done: @@ -3658,7 +3658,7 @@ ComplexMatrix Sylvester (const ComplexMatrix& a, const ComplexMatrix& b, - const ComplexMatrix& c) + const ComplexMatrix& c) { ComplexMatrix retval; @@ -3694,11 +3694,11 @@ Complex *px = cx.fortran_vec (); F77_XFCN (ztrsyl, ZTRSYL, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 ("N", 1), - 1, a_nr, b_nr, pa, a_nr, pb, - b_nr, px, a_nr, scale, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("N", 1), + 1, a_nr, b_nr, pa, a_nr, pb, + b_nr, px, a_nr, scale, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); // FIXME -- check info? @@ -3775,13 +3775,13 @@ else { if (a_nr == 0 || a_nc == 0 || b_nc == 0) - retval = ComplexMatrix (a_nr, b_nc, 0.0); + retval = ComplexMatrix (a_nr, b_nc, 0.0); else if (a.data () == b.data () && a_nr == b_nc && tra != trb) { - octave_idx_type lda = a.rows (); + octave_idx_type lda = a.rows (); retval = ComplexMatrix (a_nr, b_nc); - Complex *c = retval.fortran_vec (); + Complex *c = retval.fortran_vec (); const char *ctra = get_blas_trans_arg (tra, cja); if (cja || cjb) @@ -3812,15 +3812,15 @@ } else - { - octave_idx_type lda = a.rows (), tda = a.cols (); - octave_idx_type ldb = b.rows (), tdb = b.cols (); - - retval = ComplexMatrix (a_nr, b_nc); - Complex *c = retval.fortran_vec (); - - if (b_nc == 1 && a_nr == 1) - { + { + octave_idx_type lda = a.rows (), tda = a.cols (); + octave_idx_type ldb = b.rows (), tdb = b.cols (); + + retval = ComplexMatrix (a_nr, b_nc); + Complex *c = retval.fortran_vec (); + + if (b_nc == 1 && a_nr == 1) + { if (cja == cjb) { F77_FUNC (xzdotu, XZDOTU) (a_nc, a.data (), 1, b.data (), 1, *c); @@ -3847,18 +3847,18 @@ a.data (), 1, 0.0, c, 1 F77_CHAR_ARG_LEN (1))); } - else - { + else + { const char *ctra = get_blas_trans_arg (tra, cja); const char *ctrb = get_blas_trans_arg (trb, cjb); - F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (ctra, 1), - F77_CONST_CHAR_ARG2 (ctrb, 1), - a_nr, b_nc, a_nc, 1.0, a.data (), - lda, b.data (), ldb, 0.0, c, a_nr - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - } - } + F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (ctra, 1), + F77_CONST_CHAR_ARG2 (ctrb, 1), + a_nr, b_nc, a_nc, 1.0, a.data (), + lda, b.data (), ldb, 0.0, c, a_nr + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + } + } } return retval; @@ -3890,8 +3890,8 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - octave_quit (); - result (i, j) = xmin (c, m (i, j)); + octave_quit (); + result (i, j) = xmin (c, m (i, j)); } return result; @@ -3910,8 +3910,8 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - octave_quit (); - result (i, j) = xmin (m (i, j), c); + octave_quit (); + result (i, j) = xmin (m (i, j), c); } return result; @@ -3926,7 +3926,7 @@ if (nr != b.rows () || nc != b.columns ()) { (*current_liboctave_error_handler) - ("two-arg min expecting args of same size"); + ("two-arg min expecting args of same size"); return ComplexMatrix (); } @@ -3938,28 +3938,28 @@ { int columns_are_real_only = 1; for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) - { - columns_are_real_only = 0; - break; - } - } + { + octave_quit (); + if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) + { + columns_are_real_only = 0; + break; + } + } if (columns_are_real_only) - { - for (octave_idx_type i = 0; i < nr; i++) - result (i, j) = xmin (std::real (a (i, j)), std::real (b (i, j))); - } + { + for (octave_idx_type i = 0; i < nr; i++) + result (i, j) = xmin (std::real (a (i, j)), std::real (b (i, j))); + } else - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = xmin (a (i, j), b (i, j)); - } - } + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = xmin (a (i, j), b (i, j)); + } + } } return result; @@ -3978,8 +3978,8 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - octave_quit (); - result (i, j) = xmax (c, m (i, j)); + octave_quit (); + result (i, j) = xmax (c, m (i, j)); } return result; @@ -3998,8 +3998,8 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - octave_quit (); - result (i, j) = xmax (m (i, j), c); + octave_quit (); + result (i, j) = xmax (m (i, j), c); } return result; @@ -4014,7 +4014,7 @@ if (nr != b.rows () || nc != b.columns ()) { (*current_liboctave_error_handler) - ("two-arg max expecting args of same size"); + ("two-arg max expecting args of same size"); return ComplexMatrix (); } @@ -4026,31 +4026,31 @@ { int columns_are_real_only = 1; for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) - { - columns_are_real_only = 0; - break; - } - } + { + octave_quit (); + if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) + { + columns_are_real_only = 0; + break; + } + } if (columns_are_real_only) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = xmax (std::real (a (i, j)), std::real (b (i, j))); - } - } + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = xmax (std::real (a (i, j)), std::real (b (i, j))); + } + } else - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = xmax (a (i, j), b (i, j)); - } - } + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = xmax (a (i, j), b (i, j)); + } + } } return result;
--- a/liboctave/CNDArray.cc +++ b/liboctave/CNDArray.cc @@ -81,7 +81,7 @@ // Need to be careful here about the distance between fft's for (octave_idx_type k = 0; k < nloop; k++) octave_fftw::fft (in + k * stride * n, out + k * stride * n, - n, howmany, stride, dist); + n, howmany, stride, dist); return retval; } @@ -112,7 +112,7 @@ // Need to be careful here about the distance between fft's for (octave_idx_type k = 0; k < nloop; k++) octave_fftw::ifft (in + k * stride * n, out + k * stride * n, - n, howmany, stride, dist); + n, howmany, stride, dist); return retval; } @@ -237,17 +237,17 @@ for (octave_idx_type k = 0; k < nloop; k++) { for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + octave_quit (); - for (octave_idx_type i = 0; i < npts; i++) - tmp[i] = elem((i + k*npts)*stride + j*dist); + for (octave_idx_type i = 0; i < npts; i++) + tmp[i] = elem((i + k*npts)*stride + j*dist); - F77_FUNC (zfftf, ZFFTF) (npts, tmp, pwsave); + F77_FUNC (zfftf, ZFFTF) (npts, tmp, pwsave); - for (octave_idx_type i = 0; i < npts; i++) - retval ((i + k*npts)*stride + j*dist) = tmp[i]; - } + for (octave_idx_type i = 0; i < npts; i++) + retval ((i + k*npts)*stride + j*dist) = tmp[i]; + } } return retval; @@ -284,18 +284,18 @@ for (octave_idx_type k = 0; k < nloop; k++) { for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + octave_quit (); - for (octave_idx_type i = 0; i < npts; i++) - tmp[i] = elem((i + k*npts)*stride + j*dist); + for (octave_idx_type i = 0; i < npts; i++) + tmp[i] = elem((i + k*npts)*stride + j*dist); - F77_FUNC (zfftb, ZFFTB) (npts, tmp, pwsave); + F77_FUNC (zfftb, ZFFTB) (npts, tmp, pwsave); - for (octave_idx_type i = 0; i < npts; i++) - retval ((i + k*npts)*stride + j*dist) = tmp[i] / - static_cast<double> (npts); - } + for (octave_idx_type i = 0; i < npts; i++) + retval ((i + k*npts)*stride + j*dist) = tmp[i] / + static_cast<double> (npts); + } } return retval; @@ -321,27 +321,27 @@ octave_idx_type howmany = numel () / npts; howmany = (stride == 1 ? howmany : - (howmany > stride ? stride : howmany)); + (howmany > stride ? stride : howmany)); octave_idx_type nloop = (stride == 1 ? 1 : numel () / npts / stride); octave_idx_type dist = (stride == 1 ? npts : 1); F77_FUNC (zffti, ZFFTI) (npts, pwsave); for (octave_idx_type k = 0; k < nloop; k++) - { - for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + for (octave_idx_type j = 0; j < howmany; j++) + { + octave_quit (); - for (octave_idx_type l = 0; l < npts; l++) - prow[l] = retval ((l + k*npts)*stride + j*dist); + for (octave_idx_type l = 0; l < npts; l++) + prow[l] = retval ((l + k*npts)*stride + j*dist); - F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); + F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l]; - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l]; + } + } stride *= dv2(i); } @@ -369,28 +369,28 @@ octave_idx_type howmany = numel () / npts; howmany = (stride == 1 ? howmany : - (howmany > stride ? stride : howmany)); + (howmany > stride ? stride : howmany)); octave_idx_type nloop = (stride == 1 ? 1 : numel () / npts / stride); octave_idx_type dist = (stride == 1 ? npts : 1); F77_FUNC (zffti, ZFFTI) (npts, pwsave); for (octave_idx_type k = 0; k < nloop; k++) - { - for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + for (octave_idx_type j = 0; j < howmany; j++) + { + octave_quit (); - for (octave_idx_type l = 0; l < npts; l++) - prow[l] = retval ((l + k*npts)*stride + j*dist); + for (octave_idx_type l = 0; l < npts; l++) + prow[l] = retval ((l + k*npts)*stride + j*dist); - F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); + F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<double> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<double> (npts); + } + } stride *= dv2(i); } @@ -417,27 +417,27 @@ octave_idx_type howmany = numel () / npts; howmany = (stride == 1 ? howmany : - (howmany > stride ? stride : howmany)); + (howmany > stride ? stride : howmany)); octave_idx_type nloop = (stride == 1 ? 1 : numel () / npts / stride); octave_idx_type dist = (stride == 1 ? npts : 1); F77_FUNC (zffti, ZFFTI) (npts, pwsave); for (octave_idx_type k = 0; k < nloop; k++) - { - for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + for (octave_idx_type j = 0; j < howmany; j++) + { + octave_quit (); - for (octave_idx_type l = 0; l < npts; l++) - prow[l] = retval ((l + k*npts)*stride + j*dist); + for (octave_idx_type l = 0; l < npts; l++) + prow[l] = retval ((l + k*npts)*stride + j*dist); - F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); + F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l]; - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l]; + } + } stride *= dv(i); } @@ -464,28 +464,28 @@ octave_idx_type howmany = numel () / npts; howmany = (stride == 1 ? howmany : - (howmany > stride ? stride : howmany)); + (howmany > stride ? stride : howmany)); octave_idx_type nloop = (stride == 1 ? 1 : numel () / npts / stride); octave_idx_type dist = (stride == 1 ? npts : 1); F77_FUNC (zffti, ZFFTI) (npts, pwsave); for (octave_idx_type k = 0; k < nloop; k++) - { - for (octave_idx_type j = 0; j < howmany; j++) - { - octave_quit (); + { + for (octave_idx_type j = 0; j < howmany; j++) + { + octave_quit (); - for (octave_idx_type l = 0; l < npts; l++) - prow[l] = retval ((l + k*npts)*stride + j*dist); + for (octave_idx_type l = 0; l < npts; l++) + prow[l] = retval ((l + k*npts)*stride + j*dist); - F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); + F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<double> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<double> (npts); + } + } stride *= dv(i); } @@ -514,7 +514,7 @@ { Complex val = elem (i); if (xisnan (val)) - return true; + return true; } return false; } @@ -528,7 +528,7 @@ { Complex val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; } @@ -561,10 +561,10 @@ min_val = r_val; if (i_val > max_val) - max_val = i_val; + max_val = i_val; if (i_val < max_val) - min_val = i_val; + min_val = i_val; } else return false; @@ -577,19 +577,19 @@ double i_val = std::imag (val); if (r_val > max_val) - max_val = r_val; + max_val = r_val; if (i_val > max_val) - max_val = i_val; + max_val = i_val; if (r_val < min_val) - min_val = r_val; + min_val = r_val; if (i_val < min_val) - min_val = i_val; + min_val = i_val; if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) - return false; + return false; } return true; @@ -608,10 +608,10 @@ double i_val = std::imag (val); if ((! (xisnan (r_val) || xisinf (r_val)) - && fabs (r_val) > FLT_MAX) - || (! (xisnan (i_val) || xisinf (i_val)) - && fabs (i_val) > FLT_MAX)) - return true; + && fabs (r_val) > FLT_MAX) + || (! (xisnan (i_val) || xisinf (i_val)) + && fabs (i_val) > FLT_MAX)) + return true; } return false; @@ -792,14 +792,14 @@ a_ra_idx.elem (1) = c; for (int i = 0; i < n; i++) - { - if (a_ra_idx (i) < 0 || (a_ra_idx (i) + a_dv (i)) > dimensions (i)) - { - (*current_liboctave_error_handler) - ("Array<T>::insert: range error for insert"); - return *this; - } - } + { + if (a_ra_idx (i) < 0 || (a_ra_idx (i) + a_dv (i)) > dimensions (i)) + { + (*current_liboctave_error_handler) + ("Array<T>::insert: range error for insert"); + return *this; + } + } a_ra_idx.elem (0) = 0; a_ra_idx.elem (1) = 0; @@ -809,16 +809,16 @@ // IS make_unique () NECCESSARY HERE?? for (octave_idx_type i = 0; i < n_elt; i++) - { - Array<octave_idx_type> ra_idx = a_ra_idx; - - ra_idx.elem (0) = a_ra_idx (0) + r; - ra_idx.elem (1) = a_ra_idx (1) + c; - - elem (ra_idx) = a.elem (a_ra_idx); + { + Array<octave_idx_type> ra_idx = a_ra_idx; + + ra_idx.elem (0) = a_ra_idx (0) + r; + ra_idx.elem (1) = a_ra_idx (1) + c; + + elem (ra_idx) = a.elem (a_ra_idx); - increment_index (a_ra_idx, a_dv); - } + increment_index (a_ra_idx, a_dv); + } } else (*current_liboctave_error_handler) @@ -857,15 +857,15 @@ void ComplexNDArray::increment_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions, - int start_dimension) + const dim_vector& dimensions, + int start_dimension) { ::increment_index (ra_idx, dimensions, start_dimension); } octave_idx_type ComplexNDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); } @@ -900,13 +900,13 @@ { Complex tmp; for (octave_idx_type i = 0; i < nel; i++) - { - tmp = octave_read_value<Complex> (is); - if (is) - a.elem (i) = tmp; - else - goto done; - } + { + tmp = octave_read_value<Complex> (is); + if (is) + a.elem (i) = tmp; + else + goto done; + } } done:
--- a/liboctave/CRowVector.cc +++ b/liboctave/CRowVector.cc @@ -42,14 +42,14 @@ { F77_RET_T F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const Complex&, - const Complex*, const octave_idx_type&, const Complex*, - const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const Complex&, + const Complex*, const octave_idx_type&, const Complex*, + const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xzdotu, XZDOTU) (const octave_idx_type&, const Complex*, const octave_idx_type&, - const Complex*, const octave_idx_type&, Complex&); + const Complex*, const octave_idx_type&, Complex&); } // Complex Row Vector class @@ -94,7 +94,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (c+i) = a.elem (i); + xelem (c+i) = a.elem (i); } return *this; @@ -116,7 +116,7 @@ make_unique (); for (octave_idx_type i = 0; i < a_len; i++) - xelem (c+i) = a.elem (i); + xelem (c+i) = a.elem (i); } return *this; @@ -132,7 +132,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -148,7 +148,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -172,7 +172,7 @@ make_unique (); for (octave_idx_type i = c1; i <= c2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -196,7 +196,7 @@ make_unique (); for (octave_idx_type i = c1; i <= c2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -337,21 +337,21 @@ else { if (len == 0) - retval.resize (a_nc, 0.0); + retval.resize (a_nc, 0.0); else - { - // Transpose A to form A'*x == (x'*A)' + { + // Transpose A to form A'*x == (x'*A)' - octave_idx_type ld = a_nr; + octave_idx_type ld = a_nr; - retval.resize (a_nc); - Complex *y = retval.fortran_vec (); + retval.resize (a_nc); + Complex *y = retval.fortran_vec (); - F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("T", 1), - a_nr, a_nc, 1.0, a.data (), - ld, v.data (), 1, 0.0, y, 1 - F77_CHAR_ARG_LEN (1))); - } + F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("T", 1), + a_nr, a_nc, 1.0, a.data (), + ld, v.data (), 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); + } } return retval; @@ -379,8 +379,8 @@ for (octave_idx_type i = 1; i < len; i++) if (std::abs (elem (i)) < absres) { - res = elem (i); - absres = std::abs (res); + res = elem (i); + absres = std::abs (res); } return res; @@ -399,8 +399,8 @@ for (octave_idx_type i = 1; i < len; i++) if (std::abs (elem (i)) > absres) { - res = elem (i); - absres = std::abs (res); + res = elem (i); + absres = std::abs (res); } return res;
--- a/liboctave/CSparse.cc +++ b/liboctave/CSparse.cc @@ -67,57 +67,57 @@ { F77_RET_T F77_FUNC (zgbtrf, ZGBTRF) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type*, octave_idx_type&); + const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (zgbtrs, ZGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const Complex*, const octave_idx_type&, - const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + const Complex*, const octave_idx_type&, + const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgbcon, ZGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, Complex*, - const octave_idx_type&, const octave_idx_type*, const double&, - double&, Complex*, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, Complex*, + const octave_idx_type&, const octave_idx_type*, const double&, + double&, Complex*, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpbtrf, ZPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpbtrs, ZPBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); 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*, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, Complex*, const octave_idx_type&, + const double&, double&, Complex*, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgttrf, ZGTTRF) (const octave_idx_type&, Complex*, Complex*, Complex*, - Complex*, octave_idx_type*, octave_idx_type&); + Complex*, octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (zgttrs, ZGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const Complex*, const Complex*, - const Complex*, const Complex*, const octave_idx_type*, - Complex *, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const Complex*, const Complex*, + const Complex*, const Complex*, const octave_idx_type*, + Complex *, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&, double*, Complex*, - Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&, Complex*, Complex*, - Complex*, Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, Complex*, const octave_idx_type&, octave_idx_type&); } SparseComplexMatrix::SparseComplexMatrix (const SparseMatrix& a) @@ -184,7 +184,7 @@ for (octave_idx_type i = 0; i < nc + 1; i++) if (cidx(i) != a.cidx(i)) - return false; + return false; for (octave_idx_type i = 0; i < nz; i++) if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) @@ -208,30 +208,30 @@ if (nr == nc && nr > 0) { for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ri = ridx(i); - - if (ri != j) - { - bool found = false; - - for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) - { - if (ridx(k) == j) - { - if (data(i) == conj(data(k))) - found = true; - break; - } - } - - if (! found) - return false; - } - } - } + { + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ri = ridx(i); + + if (ri != j) + { + bool found = false; + + for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) + { + if (ridx(k) == j) + { + if (data(i) == conj(data(k))) + found = true; + break; + } + } + + if (! found) + return false; + } + } + } return true; } @@ -268,105 +268,105 @@ idx_arg.clear (1, nc); octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp_max; - double abs_max = octave_NaN; - octave_idx_type idx_j = 0; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) != idx_j) - break; - else - idx_j++; - } - - if (idx_j != nr) - { - tmp_max = 0.; - abs_max = 0.; - } - - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - Complex tmp = data (i); - - if (xisnan (tmp)) - continue; - - double abs_tmp = std::abs (tmp); - - if (xisnan (abs_max) || abs_tmp > abs_max) - { - idx_j = ridx (i); - tmp_max = tmp; - abs_max = abs_tmp; - } - } - - idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; - if (abs_max != 0.) - nel++; - } + { + Complex tmp_max; + double abs_max = octave_NaN; + octave_idx_type idx_j = 0; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) != idx_j) + break; + else + idx_j++; + } + + if (idx_j != nr) + { + tmp_max = 0.; + abs_max = 0.; + } + + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + Complex tmp = data (i); + + if (xisnan (tmp)) + continue; + + double abs_tmp = std::abs (tmp); + + if (xisnan (abs_max) || abs_tmp > abs_max) + { + idx_j = ridx (i); + tmp_max = tmp; + abs_max = abs_tmp; + } + } + + idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; + if (abs_max != 0.) + nel++; + } result = SparseComplexMatrix (1, nc, nel); octave_idx_type ii = 0; result.xcidx (0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = elem (idx_arg(j), j); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = 0; - } - result.xcidx (j+1) = ii; - } + { + Complex tmp = elem (idx_arg(j), j); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = 0; + } + result.xcidx (j+1) = ii; + } } else { idx_arg.resize_fill (nr, 1, 0); for (octave_idx_type i = cidx(0); i < cidx(1); i++) - idx_arg.elem(ridx(i)) = -1; + idx_arg.elem(ridx(i)) = -1; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - if (idx_arg.elem(i) != -1) - continue; - bool found = false; - for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) - if (ridx(k) == i) - { - found = true; - break; - } - - if (!found) - idx_arg.elem(i) = j; - - } + for (octave_idx_type i = 0; i < nr; i++) + { + if (idx_arg.elem(i) != -1) + continue; + bool found = false; + for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) + if (ridx(k) == i) + { + found = true; + break; + } + + if (!found) + idx_arg.elem(i) = j; + + } for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ir = ridx (i); - octave_idx_type ix = idx_arg.elem (ir); - Complex tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (ix == -1 || std::abs(tmp) > std::abs(elem (ir, ix))) - idx_arg.elem (ir) = j; - } - } + { + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ir = ridx (i); + octave_idx_type ix = idx_arg.elem (ir); + Complex tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (ix == -1 || std::abs(tmp) > std::abs(elem (ir, ix))) + idx_arg.elem (ir) = j; + } + } octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nr; j++) - if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) - nel++; + if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) + nel++; result = SparseComplexMatrix (nr, 1, nel); @@ -374,23 +374,23 @@ result.xcidx (0) = 0; result.xcidx (1) = nel; for (octave_idx_type j = 0; j < nr; j++) - { - if (idx_arg(j) == -1) - { - idx_arg(j) = 0; - result.xdata (ii) = Complex_NaN_result; - result.xridx (ii++) = j; - } - else - { - Complex tmp = elem (j, idx_arg(j)); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = j; - } - } - } + { + if (idx_arg(j) == -1) + { + idx_arg(j) = 0; + result.xdata (ii) = Complex_NaN_result; + result.xridx (ii++) = j; + } + else + { + Complex tmp = elem (j, idx_arg(j)); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = j; + } + } + } } return result; @@ -423,105 +423,105 @@ idx_arg.clear (1, nc); octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp_min; - double abs_min = octave_NaN; - octave_idx_type idx_j = 0; - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) != idx_j) - break; - else - idx_j++; - } - - if (idx_j != nr) - { - tmp_min = 0.; - abs_min = 0.; - } - - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - Complex tmp = data (i); - - if (xisnan (tmp)) - continue; - - double abs_tmp = std::abs (tmp); - - if (xisnan (abs_min) || abs_tmp < abs_min) - { - idx_j = ridx (i); - tmp_min = tmp; - abs_min = abs_tmp; - } - } - - idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; - if (abs_min != 0.) - nel++; - } + { + Complex tmp_min; + double abs_min = octave_NaN; + octave_idx_type idx_j = 0; + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) != idx_j) + break; + else + idx_j++; + } + + if (idx_j != nr) + { + tmp_min = 0.; + abs_min = 0.; + } + + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + Complex tmp = data (i); + + if (xisnan (tmp)) + continue; + + double abs_tmp = std::abs (tmp); + + if (xisnan (abs_min) || abs_tmp < abs_min) + { + idx_j = ridx (i); + tmp_min = tmp; + abs_min = abs_tmp; + } + } + + idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; + if (abs_min != 0.) + nel++; + } result = SparseComplexMatrix (1, nc, nel); octave_idx_type ii = 0; result.xcidx (0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = elem (idx_arg(j), j); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = 0; - } - result.xcidx (j+1) = ii; - } + { + Complex tmp = elem (idx_arg(j), j); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = 0; + } + result.xcidx (j+1) = ii; + } } else { idx_arg.resize_fill (nr, 1, 0); for (octave_idx_type i = cidx(0); i < cidx(1); i++) - idx_arg.elem(ridx(i)) = -1; + idx_arg.elem(ridx(i)) = -1; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - if (idx_arg.elem(i) != -1) - continue; - bool found = false; - for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) - if (ridx(k) == i) - { - found = true; - break; - } - - if (!found) - idx_arg.elem(i) = j; - - } + for (octave_idx_type i = 0; i < nr; i++) + { + if (idx_arg.elem(i) != -1) + continue; + bool found = false; + for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) + if (ridx(k) == i) + { + found = true; + break; + } + + if (!found) + idx_arg.elem(i) = j; + + } for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ir = ridx (i); - octave_idx_type ix = idx_arg.elem (ir); - Complex tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (ix == -1 || std::abs(tmp) < std::abs(elem (ir, ix))) - idx_arg.elem (ir) = j; - } - } + { + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ir = ridx (i); + octave_idx_type ix = idx_arg.elem (ir); + Complex tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (ix == -1 || std::abs(tmp) < std::abs(elem (ir, ix))) + idx_arg.elem (ir) = j; + } + } octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nr; j++) - if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) - nel++; + if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) + nel++; result = SparseComplexMatrix (nr, 1, nel); @@ -529,23 +529,23 @@ result.xcidx (0) = 0; result.xcidx (1) = nel; for (octave_idx_type j = 0; j < nr; j++) - { - if (idx_arg(j) == -1) - { - idx_arg(j) = 0; - result.xdata (ii) = Complex_NaN_result; - result.xridx (ii++) = j; - } - else - { - Complex tmp = elem (j, idx_arg(j)); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = j; - } - } - } + { + if (idx_arg(j) == -1) + { + idx_arg(j) = 0; + result.xdata (ii) = Complex_NaN_result; + result.xridx (ii++) = j; + } + else + { + Complex tmp = elem (j, idx_arg(j)); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = j; + } + } + } } return result; @@ -614,7 +614,7 @@ SparseComplexMatrix SparseComplexMatrix::concat (const SparseComplexMatrix& rb, - const Array<octave_idx_type>& ra_idx) + const Array<octave_idx_type>& ra_idx) { // Don't use numel to avoid all possiblity of an overflow if (rb.rows () > 0 && rb.cols () > 0) @@ -668,9 +668,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) { - octave_idx_type q = retval.xcidx (ridx (k) + 1)++; - retval.xridx (q) = j; - retval.xdata (q) = conj (data (k)); + octave_idx_type q = retval.xcidx (ridx (k) + 1)++; + retval.xridx (q) = j; + retval.xdata (q) = conj (data (k)); } assert (nnz () == retval.xcidx (nr)); // retval.xcidx[1:nr] holds row entry *end* offsets for rows 0:(nr-1) @@ -725,8 +725,8 @@ SparseComplexMatrix SparseComplexMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, - double& rcond, const bool, - const bool calccond) const + double& rcond, const bool, + const bool calccond) const { SparseComplexMatrix retval; @@ -743,35 +743,35 @@ mattyp.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - if (typ == MatrixType::Permuted_Diagonal) - retval = transpose(); - else - retval = *this; - - // Force make_unique to be called - Complex *v = retval.data(); - - if (calccond) - { - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nr; i++) - { - double tmp = std::abs(v[i]); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; - } - - for (octave_idx_type i = 0; i < nr; i++) - v[i] = 1.0 / v[i]; - } + typ == MatrixType::Permuted_Diagonal) + { + if (typ == MatrixType::Permuted_Diagonal) + retval = transpose(); + else + retval = *this; + + // Force make_unique to be called + Complex *v = retval.data(); + + if (calccond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nr; i++) + { + double tmp = std::abs(v[i]); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + + for (octave_idx_type i = 0; i < nr; i++) + v[i] = 1.0 / v[i]; + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -779,8 +779,8 @@ SparseComplexMatrix SparseComplexMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, - double& rcond, const bool, - const bool calccond) const + double& rcond, const bool, + const bool calccond) const { SparseComplexMatrix retval; @@ -797,256 +797,256 @@ mattyp.info (); if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || - typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) - { - double anorm = 0.; - double ainvnorm = 0.; - - if (calccond) - { - // Calculate the 1-norm of matrix for rcond calculation - 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; - } - } - - if (typ == MatrixType::Upper || typ == MatrixType::Lower) - { - octave_idx_type nz = nnz (); - octave_idx_type cx = 0; - octave_idx_type nz2 = nz; - retval = SparseComplexMatrix (nr, nc, nz2); - - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - // place the 1 in the identity position - octave_idx_type cx_colstart = cx; - - if (cx == nz2) - { - nz2 *= 2; - retval.change_capacity (nz2); - } - - retval.xcidx(i) = cx; - retval.xridx(cx) = i; - retval.xdata(cx) = 1.0; - cx++; - - // iterate accross columns of input matrix - for (octave_idx_type j = i+1; j < nr; j++) - { - Complex v = 0.; - // iterate to calculate sum - octave_idx_type colXp = retval.xcidx(i); - octave_idx_type colUp = cidx(j); - octave_idx_type rpX, rpU; - - if (cidx(j) == cidx(j+1)) - { - (*current_liboctave_error_handler) - ("division by zero"); - goto inverse_singular; - } - - do - { - octave_quit (); - rpX = retval.xridx(colXp); - rpU = ridx(colUp); - - if (rpX < rpU) - colXp++; - else if (rpX > rpU) - colUp++; - else - { - v -= retval.xdata(colXp) * data(colUp); - colXp++; - colUp++; - } - } while ((rpX<j) && (rpU<j) && - (colXp<cx) && (colUp<nz)); - - - // get A(m,m) - if (typ == MatrixType::Upper) - colUp = cidx(j+1) - 1; - else - colUp = cidx(j); - Complex pivot = data(colUp); - if (pivot == 0. || ridx(colUp) != j) - { - (*current_liboctave_error_handler) - ("division by zero"); - goto inverse_singular; - } - - if (v != 0.) - { - if (cx == nz2) - { - nz2 *= 2; - retval.change_capacity (nz2); - } - - retval.xridx(cx) = j; - retval.xdata(cx) = v / pivot; - cx++; - } - } - - // get A(m,m) - octave_idx_type colUp; - if (typ == MatrixType::Upper) - colUp = cidx(i+1) - 1; - else - colUp = cidx(i); - Complex pivot = data(colUp); - if (pivot == 0. || ridx(colUp) != i) - { - (*current_liboctave_error_handler) ("division by zero"); - goto inverse_singular; - } - - if (pivot != 1.0) - for (octave_idx_type j = cx_colstart; j < cx; j++) - retval.xdata(j) /= pivot; - } - retval.xcidx(nr) = cx; - retval.maybe_compress (); - } - else - { - octave_idx_type nz = nnz (); - octave_idx_type cx = 0; - octave_idx_type nz2 = nz; - retval = SparseComplexMatrix (nr, nc, nz2); - - OCTAVE_LOCAL_BUFFER (Complex, work, nr); - OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); - - octave_idx_type *perm = mattyp.triangular_perm(); - if (typ == MatrixType::Permuted_Upper) - { - for (octave_idx_type i = 0; i < nr; i++) - rperm[perm[i]] = i; - } - else - { - for (octave_idx_type i = 0; i < nr; i++) - rperm[i] = perm[i]; - for (octave_idx_type i = 0; i < nr; i++) - perm[rperm[i]] = i; - } - - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - octave_idx_type iidx = rperm[i]; - - for (octave_idx_type j = 0; j < nr; j++) - work[j] = 0.; - - // place the 1 in the identity position - work[iidx] = 1.0; - - // iterate accross columns of input matrix - for (octave_idx_type j = iidx+1; j < nr; j++) - { - Complex v = 0.; - octave_idx_type jidx = perm[j]; - // iterate to calculate sum - for (octave_idx_type k = cidx(jidx); - k < cidx(jidx+1); k++) - { - octave_quit (); - v -= work[ridx(k)] * data(k); - } - - // get A(m,m) - Complex pivot; - if (typ == MatrixType::Permuted_Upper) - pivot = data(cidx(jidx+1) - 1); - else - pivot = data(cidx(jidx)); - if (pivot == 0.) - { - (*current_liboctave_error_handler) - ("division by zero"); - goto inverse_singular; - } - - work[j] = v / pivot; - } - - // get A(m,m) - octave_idx_type colUp; - if (typ == MatrixType::Permuted_Upper) - colUp = cidx(perm[iidx]+1) - 1; - else - colUp = cidx(perm[iidx]); - - Complex pivot = data(colUp); - if (pivot == 0.) - { - (*current_liboctave_error_handler) - ("division by zero"); - goto inverse_singular; - } - - octave_idx_type new_cx = cx; - for (octave_idx_type j = iidx; j < nr; j++) - if (work[j] != 0.0) - { - new_cx++; - if (pivot != 1.0) - work[j] /= pivot; - } - - if (cx < new_cx) - { - nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); - retval.change_capacity (nz2); - } - - retval.xcidx(i) = cx; - for (octave_idx_type j = iidx; j < nr; j++) - if (work[j] != 0.) - { - retval.xridx(cx) = j; - retval.xdata(cx++) = work[j]; - } - } - - retval.xcidx(nr) = cx; - retval.maybe_compress (); - } - - if (calccond) - { - // Calculate the 1-norm of inverse matrix for rcond calculation - for (octave_idx_type j = 0; j < nr; j++) - { - double atmp = 0.; - for (octave_idx_type i = retval.cidx(j); - i < retval.cidx(j+1); i++) - atmp += std::abs(retval.data(i)); - if (atmp > ainvnorm) - ainvnorm = atmp; - } - - rcond = 1. / ainvnorm / anorm; - } - } + typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + { + double anorm = 0.; + double ainvnorm = 0.; + + if (calccond) + { + // Calculate the 1-norm of matrix for rcond calculation + 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; + } + } + + if (typ == MatrixType::Upper || typ == MatrixType::Lower) + { + octave_idx_type nz = nnz (); + octave_idx_type cx = 0; + octave_idx_type nz2 = nz; + retval = SparseComplexMatrix (nr, nc, nz2); + + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + // place the 1 in the identity position + octave_idx_type cx_colstart = cx; + + if (cx == nz2) + { + nz2 *= 2; + retval.change_capacity (nz2); + } + + retval.xcidx(i) = cx; + retval.xridx(cx) = i; + retval.xdata(cx) = 1.0; + cx++; + + // iterate accross columns of input matrix + for (octave_idx_type j = i+1; j < nr; j++) + { + Complex v = 0.; + // iterate to calculate sum + octave_idx_type colXp = retval.xcidx(i); + octave_idx_type colUp = cidx(j); + octave_idx_type rpX, rpU; + + if (cidx(j) == cidx(j+1)) + { + (*current_liboctave_error_handler) + ("division by zero"); + goto inverse_singular; + } + + do + { + octave_quit (); + rpX = retval.xridx(colXp); + rpU = ridx(colUp); + + if (rpX < rpU) + colXp++; + else if (rpX > rpU) + colUp++; + else + { + v -= retval.xdata(colXp) * data(colUp); + colXp++; + colUp++; + } + } while ((rpX<j) && (rpU<j) && + (colXp<cx) && (colUp<nz)); + + + // get A(m,m) + if (typ == MatrixType::Upper) + colUp = cidx(j+1) - 1; + else + colUp = cidx(j); + Complex pivot = data(colUp); + if (pivot == 0. || ridx(colUp) != j) + { + (*current_liboctave_error_handler) + ("division by zero"); + goto inverse_singular; + } + + if (v != 0.) + { + if (cx == nz2) + { + nz2 *= 2; + retval.change_capacity (nz2); + } + + retval.xridx(cx) = j; + retval.xdata(cx) = v / pivot; + cx++; + } + } + + // get A(m,m) + octave_idx_type colUp; + if (typ == MatrixType::Upper) + colUp = cidx(i+1) - 1; + else + colUp = cidx(i); + Complex pivot = data(colUp); + if (pivot == 0. || ridx(colUp) != i) + { + (*current_liboctave_error_handler) ("division by zero"); + goto inverse_singular; + } + + if (pivot != 1.0) + for (octave_idx_type j = cx_colstart; j < cx; j++) + retval.xdata(j) /= pivot; + } + retval.xcidx(nr) = cx; + retval.maybe_compress (); + } + else + { + octave_idx_type nz = nnz (); + octave_idx_type cx = 0; + octave_idx_type nz2 = nz; + retval = SparseComplexMatrix (nr, nc, nz2); + + OCTAVE_LOCAL_BUFFER (Complex, work, nr); + OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); + + octave_idx_type *perm = mattyp.triangular_perm(); + if (typ == MatrixType::Permuted_Upper) + { + for (octave_idx_type i = 0; i < nr; i++) + rperm[perm[i]] = i; + } + else + { + for (octave_idx_type i = 0; i < nr; i++) + rperm[i] = perm[i]; + for (octave_idx_type i = 0; i < nr; i++) + perm[rperm[i]] = i; + } + + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + octave_idx_type iidx = rperm[i]; + + for (octave_idx_type j = 0; j < nr; j++) + work[j] = 0.; + + // place the 1 in the identity position + work[iidx] = 1.0; + + // iterate accross columns of input matrix + for (octave_idx_type j = iidx+1; j < nr; j++) + { + Complex v = 0.; + octave_idx_type jidx = perm[j]; + // iterate to calculate sum + for (octave_idx_type k = cidx(jidx); + k < cidx(jidx+1); k++) + { + octave_quit (); + v -= work[ridx(k)] * data(k); + } + + // get A(m,m) + Complex pivot; + if (typ == MatrixType::Permuted_Upper) + pivot = data(cidx(jidx+1) - 1); + else + pivot = data(cidx(jidx)); + if (pivot == 0.) + { + (*current_liboctave_error_handler) + ("division by zero"); + goto inverse_singular; + } + + work[j] = v / pivot; + } + + // get A(m,m) + octave_idx_type colUp; + if (typ == MatrixType::Permuted_Upper) + colUp = cidx(perm[iidx]+1) - 1; + else + colUp = cidx(perm[iidx]); + + Complex pivot = data(colUp); + if (pivot == 0.) + { + (*current_liboctave_error_handler) + ("division by zero"); + goto inverse_singular; + } + + octave_idx_type new_cx = cx; + for (octave_idx_type j = iidx; j < nr; j++) + if (work[j] != 0.0) + { + new_cx++; + if (pivot != 1.0) + work[j] /= pivot; + } + + if (cx < new_cx) + { + nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); + retval.change_capacity (nz2); + } + + retval.xcidx(i) = cx; + for (octave_idx_type j = iidx; j < nr; j++) + if (work[j] != 0.) + { + retval.xridx(cx) = j; + retval.xdata(cx++) = work[j]; + } + } + + retval.xcidx(nr) = cx; + retval.maybe_compress (); + } + + if (calccond) + { + // Calculate the 1-norm of inverse matrix for rcond calculation + for (octave_idx_type j = 0; j < nr; j++) + { + double atmp = 0.; + for (octave_idx_type i = retval.cidx(j); + i < retval.cidx(j+1); i++) + atmp += std::abs(retval.data(i)); + if (atmp > ainvnorm) + ainvnorm = atmp; + } + + rcond = 1. / ainvnorm / anorm; + } + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1057,7 +1057,7 @@ SparseComplexMatrix SparseComplexMatrix::inverse (MatrixType& mattype, octave_idx_type& info, - double& rcond, int, int calc_cond) const + double& rcond, int, int calc_cond) const { int typ = mattype.type (false); SparseComplexMatrix ret; @@ -1077,43 +1077,43 @@ else { if (mattype.is_hermitian()) - { - MatrixType tmp_typ (MatrixType::Upper); - SparseComplexCHOL fact (*this, info, false); - rcond = fact.rcond(); - if (info == 0) - { - double rcond2; - SparseMatrix Q = fact.Q(); - SparseComplexMatrix InvL = fact.L().transpose(). - tinverse(tmp_typ, info, rcond2, true, false); - ret = Q * InvL.hermitian() * InvL * Q.transpose(); - } - else - { - // Matrix is either singular or not positive definite - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - } + { + MatrixType tmp_typ (MatrixType::Upper); + SparseComplexCHOL fact (*this, info, false); + rcond = fact.rcond(); + if (info == 0) + { + double rcond2; + SparseMatrix Q = fact.Q(); + SparseComplexMatrix InvL = fact.L().transpose(). + tinverse(tmp_typ, info, rcond2, true, false); + ret = Q * InvL.hermitian() * InvL * Q.transpose(); + } + else + { + // Matrix is either singular or not positive definite + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + } if (!mattype.is_hermitian()) - { - octave_idx_type n = rows(); - ColumnVector Qinit(n); - for (octave_idx_type i = 0; i < n; i++) - Qinit(i) = i; - - MatrixType tmp_typ (MatrixType::Upper); - SparseComplexLU fact (*this, Qinit, Matrix (), false, false); - rcond = fact.rcond(); - double rcond2; - SparseComplexMatrix InvL = fact.L().transpose(). - tinverse(tmp_typ, info, rcond2, true, false); - SparseComplexMatrix InvU = fact.U(). - tinverse(tmp_typ, info, rcond2, true, false).transpose(); - ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); - } + { + octave_idx_type n = rows(); + ColumnVector Qinit(n); + for (octave_idx_type i = 0; i < n; i++) + Qinit(i) = i; + + MatrixType tmp_typ (MatrixType::Upper); + SparseComplexLU fact (*this, Qinit, Matrix (), false, false); + rcond = fact.rcond(); + double rcond2; + SparseComplexMatrix InvL = fact.L().transpose(). + tinverse(tmp_typ, info, rcond2, true, false); + SparseComplexMatrix InvU = fact.U(). + tinverse(tmp_typ, info, rcond2, true, false).transpose(); + ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); + } } return ret; @@ -1158,19 +1158,19 @@ double tmp = octave_sparse_params::get_key ("spumoni"); if (!xisnan (tmp)) - Control (UMFPACK_PRL) = tmp; + Control (UMFPACK_PRL) = tmp; tmp = octave_sparse_params::get_key ("piv_tol"); if (!xisnan (tmp)) - { - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - } + { + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + } // Set whether we are allowed to modify Q or not tmp = octave_sparse_params::get_key ("autoamd"); if (!xisnan (tmp)) - Control (UMFPACK_FIXQ) = tmp; + Control (UMFPACK_FIXQ) = tmp; // Turn-off UMFPACK scaling for LU Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; @@ -1182,72 +1182,72 @@ const Complex *Ax = data (); UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, 1, control); + reinterpret_cast<const double *> (Ax), + 0, 1, control); void *Symbolic; Matrix Info (1, UMFPACK_INFO); double *info = Info.fortran_vec (); int status = UMFPACK_ZNAME (qsymbolic) - (nr, nc, Ap, Ai, reinterpret_cast<const double *> (Ax), 0, - 0, &Symbolic, control, info); + (nr, nc, Ap, Ai, reinterpret_cast<const double *> (Ax), 0, + 0, &Symbolic, control, info); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::determinant symbolic factorization failed"); - - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; - } + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::determinant symbolic factorization failed"); + + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; + } else - { - UMFPACK_ZNAME (report_symbolic) (Symbolic, control); - - void *Numeric; - status - = UMFPACK_ZNAME (numeric) (Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, Symbolic, &Numeric, control, info) ; - UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; - - rcond = Info (UMFPACK_RCOND); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::determinant numeric factorization failed"); - - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - { - UMFPACK_ZNAME (report_numeric) (Numeric, control); - - double c10[2], e10; + { + UMFPACK_ZNAME (report_symbolic) (Symbolic, control); + + void *Numeric; + status + = UMFPACK_ZNAME (numeric) (Ap, Ai, + reinterpret_cast<const double *> (Ax), + 0, Symbolic, &Numeric, control, info) ; + UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; + + rcond = Info (UMFPACK_RCOND); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::determinant numeric factorization failed"); + + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + { + UMFPACK_ZNAME (report_numeric) (Numeric, control); + + double c10[2], e10; status = UMFPACK_ZNAME (get_determinant) (c10, 0, &e10, Numeric, info); - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::determinant error calculating determinant"); - - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); - } - else - retval = ComplexDET (Complex (c10[0], c10[1]), e10, 10); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - } + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::determinant error calculating determinant"); + + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); + } + else + retval = ComplexDET (Complex (c10[0], c10[1]), e10, 10); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + } } #else (*current_liboctave_error_handler) ("UMFPACK not installed"); @@ -1258,8 +1258,8 @@ ComplexMatrix SparseComplexMatrix::dsolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler, bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, bool calc_cond) const { ComplexMatrix retval; @@ -1280,37 +1280,37 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - retval.resize (nc, b.cols(), Complex(0.,0.)); - if (typ == MatrixType::Diagonal) - for (octave_idx_type j = 0; j < b.cols(); j++) - for (octave_idx_type i = 0; i < nm; i++) - retval(i,j) = b(i,j) / data (i); - else - for (octave_idx_type j = 0; j < b.cols(); j++) - for (octave_idx_type k = 0; k < nc; k++) - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - retval(k,j) = b(ridx(i),j) / data (i); - - 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; - } + typ == MatrixType::Permuted_Diagonal) + { + retval.resize (nc, b.cols(), Complex(0.,0.)); + if (typ == MatrixType::Diagonal) + for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type i = 0; i < nm; i++) + retval(i,j) = b(i,j) / data (i); + else + for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type k = 0; k < nc; k++) + for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + retval(k,j) = b(ridx(i),j) / data (i); + + 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"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1318,9 +1318,9 @@ SparseComplexMatrix SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1341,67 +1341,67 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - if (typ == MatrixType::Diagonal) - for (octave_idx_type j = 0; j < b.cols(); 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 l = 0; l < nc; l++) - for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) - { - bool found = false; - octave_idx_type k; - for (k = b.cidx(j); k < b.cidx(j+1); k++) - if (ridx(i) == b.ridx(k)) - { - found = true; - break; - } - if (found) - { - retval.xridx (ii) = l; - retval.xdata (ii++) = b.data(k) / data (i); - } - } - retval.xcidx(j+1) = ii; - } - - 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; - } + typ == MatrixType::Permuted_Diagonal) + { + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nz = b.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + if (typ == MatrixType::Diagonal) + for (octave_idx_type j = 0; j < b.cols(); 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 l = 0; l < nc; l++) + for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) + { + bool found = false; + octave_idx_type k; + for (k = b.cidx(j); k < b.cidx(j+1); k++) + if (ridx(i) == b.ridx(k)) + { + found = true; + break; + } + if (found) + { + retval.xridx (ii) = l; + retval.xdata (ii++) = b.data(k) / data (i); + } + } + retval.xcidx(j+1) = ii; + } + + 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"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1409,9 +1409,9 @@ ComplexMatrix SparseComplexMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1432,37 +1432,37 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - retval.resize (nc, b.cols(), Complex(0.,0.)); - if (typ == MatrixType::Diagonal) - for (octave_idx_type j = 0; j < b.cols(); j++) - for (octave_idx_type i = 0; i < nm; i++) - retval(i,j) = b(i,j) / data (i); - else - for (octave_idx_type j = 0; j < b.cols(); j++) - for (octave_idx_type k = 0; k < nc; k++) - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - retval(k,j) = b(ridx(i),j) / data (i); - - 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; - } + typ == MatrixType::Permuted_Diagonal) + { + retval.resize (nc, b.cols(), Complex(0.,0.)); + if (typ == MatrixType::Diagonal) + for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type i = 0; i < nm; i++) + retval(i,j) = b(i,j) / data (i); + else + for (octave_idx_type j = 0; j < b.cols(); j++) + for (octave_idx_type k = 0; k < nc; k++) + for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + retval(k,j) = b(ridx(i),j) / data (i); + + 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"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1470,9 +1470,9 @@ SparseComplexMatrix SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1493,67 +1493,67 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - if (typ == MatrixType::Diagonal) - for (octave_idx_type j = 0; j < b.cols(); 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 l = 0; l < nc; l++) - for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) - { - bool found = false; - octave_idx_type k; - for (k = b.cidx(j); k < b.cidx(j+1); k++) - if (ridx(i) == b.ridx(k)) - { - found = true; - break; - } - if (found) - { - retval.xridx (ii) = l; - retval.xdata (ii++) = b.data(k) / data (i); - } - } - retval.xcidx(j+1) = ii; - } - - 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; - } + typ == MatrixType::Permuted_Diagonal) + { + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nz = b.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + if (typ == MatrixType::Diagonal) + for (octave_idx_type j = 0; j < b.cols(); 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 l = 0; l < nc; l++) + for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) + { + bool found = false; + octave_idx_type k; + for (k = b.cidx(j); k < b.cidx(j+1); k++) + if (ridx(i) == b.ridx(k)) + { + found = true; + break; + } + if (found) + { + retval.xridx (ii) = l; + retval.xdata (ii++) = b.data(k) / data (i); + } + } + retval.xcidx(j+1) = ii; + } + + 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"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1561,9 +1561,9 @@ ComplexMatrix SparseComplexMatrix::utsolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -1584,212 +1584,212 @@ mattype.info (); if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Upper) - { - double anorm = 0.; - double ainvnorm = 0.; - octave_idx_type b_nc = b.cols (); - 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 == MatrixType::Permuted_Upper) - { - retval.resize (nc, b_nc); - octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (work[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = work[k] / data(cidx(kidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval (perm[i], j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - retval.resize (nc, b_nc); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - if (work[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Upper) + { + double anorm = 0.; + double ainvnorm = 0.; + octave_idx_type b_nc = b.cols (); + 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 == MatrixType::Permuted_Upper) + { + retval.resize (nc, b_nc); + octave_idx_type *perm = mattype.triangular_perm (); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (work[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = work[k] / data(cidx(kidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval (perm[i], j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + retval.resize (nc, b_nc); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + if (work[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1797,9 +1797,9 @@ SparseComplexMatrix SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -1820,273 +1820,273 @@ mattype.info (); if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Upper) - { - double anorm = 0.; - double ainvnorm = 0.; - 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.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Upper) - { - octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); - for (octave_idx_type i = 0; i < nc; i++) - rperm[perm[i]] = i; - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (work[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = work[k] / data(cidx(kidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[rperm[i]] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[rperm[i]]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - if (work[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Upper) + { + double anorm = 0.; + double ainvnorm = 0.; + 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.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Upper) + { + octave_idx_type *perm = mattype.triangular_perm (); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); + for (octave_idx_type i = 0; i < nc; i++) + rperm[perm[i]] = i; + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (work[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = work[k] / data(cidx(kidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[rperm[i]] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[rperm[i]]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + if (work[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; } ComplexMatrix SparseComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2107,212 +2107,212 @@ mattype.info (); if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Upper) - { - double anorm = 0.; - double ainvnorm = 0.; - octave_idx_type b_nc = b.cols (); - 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 == MatrixType::Permuted_Upper) - { - retval.resize (nc, b_nc); - octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (work[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = work[k] / data(cidx(kidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval (perm[i], j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - retval.resize (nc, b_nc); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - if (work[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Upper) + { + double anorm = 0.; + double ainvnorm = 0.; + octave_idx_type b_nc = b.cols (); + 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 == MatrixType::Permuted_Upper) + { + retval.resize (nc, b_nc); + octave_idx_type *perm = mattype.triangular_perm (); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (work[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = work[k] / data(cidx(kidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval (perm[i], j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + retval.resize (nc, b_nc); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + if (work[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -2320,9 +2320,9 @@ SparseComplexMatrix SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -2343,264 +2343,264 @@ mattype.info (); if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Upper) - { - double anorm = 0.; - double ainvnorm = 0.; - 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.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Upper) - { - octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); - for (octave_idx_type i = 0; i < nc; i++) - rperm[perm[i]] = i; - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (work[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = work[k] / data(cidx(kidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[rperm[i]] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[rperm[i]]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = nr-1; k >= 0; k--) - { - if (work[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Upper) + { + double anorm = 0.; + double ainvnorm = 0.; + 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.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Upper) + { + octave_idx_type *perm = mattype.triangular_perm (); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); + for (octave_idx_type i = 0; i < nc; i++) + rperm[perm[i]] = i; + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (work[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = work[k] / data(cidx(kidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[rperm[i]] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[rperm[i]]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = nr-1; k >= 0; k--) + { + if (work[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -2608,9 +2608,9 @@ ComplexMatrix SparseComplexMatrix::ltsolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -2631,232 +2631,232 @@ mattype.info (); if (typ == MatrixType::Permuted_Lower || - typ == MatrixType::Lower) - { - double anorm = 0.; - double ainvnorm = 0.; - octave_idx_type b_nc = b.cols (); - 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 == MatrixType::Permuted_Lower) - { - retval.resize (nc, b_nc); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - octave_idx_type *perm = mattype.triangular_perm (); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - for (octave_idx_type i = 0; i < nr; i++) - work[perm[i]] = b(i,j); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - - if (minr != k || data (mini) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - retval.resize (nc, b_nc, 0.); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Lower) + { + double anorm = 0.; + double ainvnorm = 0.; + octave_idx_type b_nc = b.cols (); + 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 == MatrixType::Permuted_Lower) + { + retval.resize (nc, b_nc); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + octave_idx_type *perm = mattype.triangular_perm (); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + for (octave_idx_type i = 0; i < nr; i++) + work[perm[i]] = b(i,j); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + + if (minr != k || data (mini) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + retval.resize (nc, b_nc, 0.); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -2864,9 +2864,9 @@ SparseComplexMatrix SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -2888,283 +2888,283 @@ mattype.info (); if (typ == MatrixType::Permuted_Lower || - typ == MatrixType::Lower) - { - double anorm = 0.; - double ainvnorm = 0.; - 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.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Lower) - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - octave_idx_type *perm = mattype.triangular_perm (); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - work[perm[b.ridx(i)]] = b.data(i); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - - if (minr != k || data (mini) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Lower) + { + double anorm = 0.; + double ainvnorm = 0.; + 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.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Lower) + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + octave_idx_type *perm = mattype.triangular_perm (); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + work[perm[b.ridx(i)]] = b.data(i); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + + if (minr != k || data (mini) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -3172,9 +3172,9 @@ ComplexMatrix SparseComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -3195,236 +3195,236 @@ mattype.info (); if (typ == MatrixType::Permuted_Lower || - typ == MatrixType::Lower) - { - double anorm = 0.; - double ainvnorm = 0.; - octave_idx_type b_nc = b.cols (); - 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 == MatrixType::Permuted_Lower) - { - retval.resize (nc, b_nc); - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - octave_idx_type *perm = mattype.triangular_perm (); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - for (octave_idx_type i = 0; i < nr; i++) - work[perm[i]] = b(i,j); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - - if (minr != k || data (mini) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - retval.resize (nc, b_nc, 0.); - - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - work[i] = 0.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = work[i]; - } - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Lower) + { + double anorm = 0.; + double ainvnorm = 0.; + octave_idx_type b_nc = b.cols (); + 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 == MatrixType::Permuted_Lower) + { + retval.resize (nc, b_nc); + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + octave_idx_type *perm = mattype.triangular_perm (); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + for (octave_idx_type i = 0; i < nr; i++) + work[perm[i]] = b(i,j); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + + if (minr != k || data (mini) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + retval.resize (nc, b_nc, 0.); + + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + work[i] = 0.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = work[i]; + } + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -3432,9 +3432,9 @@ SparseComplexMatrix SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3455,283 +3455,283 @@ mattype.info (); if (typ == MatrixType::Permuted_Lower || - typ == MatrixType::Lower) - { - double anorm = 0.; - double ainvnorm = 0.; - 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.nnz (); - retval = SparseComplexMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Lower) - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - octave_idx_type *perm = mattype.triangular_perm (); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - work[perm[b.ridx(i)]] = b.data(i); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - - if (minr != k || data (mini) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - 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; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, work, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; 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); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (work[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - 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); - } - } - } - - // 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 < nc; 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 < nc; i++) - if (work[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = work[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - 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++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - 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.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - - triangular_error: - if (err != 0) - { - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - } - - 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); - } - } + typ == MatrixType::Lower) + { + double anorm = 0.; + double ainvnorm = 0.; + 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.nnz (); + retval = SparseComplexMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Lower) + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + octave_idx_type *perm = mattype.triangular_perm (); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + work[perm[b.ridx(i)]] = b.data(i); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + + if (minr != k || data (mini) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + 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; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, work, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; 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); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (work[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + 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); + } + } + } + + // 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 < nc; 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 < nc; i++) + if (work[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = work[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + 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++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + 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.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + + triangular_error: + if (err != 0) + { + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + } + + 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 - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -3739,9 +3739,9 @@ ComplexMatrix SparseComplexMatrix::trisolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -3764,125 +3764,125 @@ mattype.info (); if (typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = std::real(data(ii++)); - DL[j] = data(ii); - ii += 2; - } - D[nc-1] = std::real(data(ii)); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = std::real(data(i)); - else if (ridx(i) == j + 1) - DL[j] = data(i); - } - } - - octave_idx_type b_nc = b.cols(); - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, - b.rows(), err)); - - if (err != 0) - { - err = 0; - mattype.mark_as_unsymmetric (); - typ = MatrixType::Tridiagonal; - } - else - rcond = 1.; - } + { + OCTAVE_LOCAL_BUFFER (double, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = std::real(data(ii++)); + DL[j] = data(ii); + ii += 2; + } + D[nc-1] = std::real(data(ii)); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = std::real(data(i)); + else if (ridx(i) == j + 1) + DL[j] = data(i); + } + } + + octave_idx_type b_nc = b.cols(); + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, + b.rows(), err)); + + if (err != 0) + { + err = 0; + mattype.mark_as_unsymmetric (); + typ = MatrixType::Tridiagonal; + } + else + rcond = 1.; + } if (typ == MatrixType::Tridiagonal) - { - OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (Complex, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = data(ii++); - DL[j] = data(ii++); - DU[j] = data(ii++); - } - D[nc-1] = data(ii); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - DU[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = data(i); - else if (ridx(i) == j + 1) - DL[j] = data(i); - else if (ridx(i) == j - 1) - DU[j-1] = data(i); - } - } - - octave_idx_type b_nc = b.cols(); - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, - b.rows(), err)); - - if (err != 0) - { - rcond = 0.; - err = -2; - - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - - } - else - rcond = 1.; - } + { + OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (Complex, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = data(ii++); + DL[j] = data(ii++); + DU[j] = data(ii++); + } + D[nc-1] = data(ii); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + DU[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = data(i); + else if (ridx(i) == j + 1) + DL[j] = data(i); + else if (ridx(i) == j - 1) + DU[j-1] = data(i); + } + } + + octave_idx_type b_nc = b.cols(); + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, + b.rows(), err)); + + if (err != 0) + { + rcond = 0.; + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision"); + + } + else + rcond = 1.; + } else if (typ != MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -3890,9 +3890,9 @@ SparseComplexMatrix SparseComplexMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -3916,120 +3916,120 @@ // Note can't treat symmetric case as there is no dpttrf function if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); - OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (Complex, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = data(ii++); - DL[j] = data(ii++); - DU[j] = data(ii++); - } - D[nc-1] = data(ii); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - DU[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = data(i); - else if (ridx(i) == j + 1) - DL[j] = data(i); - else if (ridx(i) == j - 1) - DU[j-1] = data(i); - } - } - - F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); - - 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"); - - } - else - { - 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; - rcond = 1.0; - - OCTAVE_LOCAL_BUFFER (Complex, work, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - 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 (zgttrs, ZGTTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, 1, DL, D, DU, DU2, pipvt, - work, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - // 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 (); - } - } + typ == MatrixType::Tridiagonal_Hermitian) + { + OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); + OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (Complex, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = data(ii++); + DL[j] = data(ii++); + DU[j] = data(ii++); + } + D[nc-1] = data(ii); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + DU[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = data(i); + else if (ridx(i) == j + 1) + DL[j] = data(i); + else if (ridx(i) == j - 1) + DU[j-1] = data(i); + } + } + + F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); + + 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"); + + } + else + { + 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; + rcond = 1.0; + + OCTAVE_LOCAL_BUFFER (Complex, work, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + 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 (zgttrs, ZGTTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, 1, DL, D, DU, DU2, pipvt, + work, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + // 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 (); + } + } else if (typ != MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4037,9 +4037,9 @@ ComplexMatrix SparseComplexMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4062,126 +4062,126 @@ mattype.info (); if (typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = std::real(data(ii++)); - DL[j] = data(ii); - ii += 2; - } - D[nc-1] = std::real(data(ii)); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = std::real (data(i)); - else if (ridx(i) == j + 1) - DL[j] = data(i); - } - } - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols(); - rcond = 1.; - - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, - b_nr, err)); - - if (err != 0) - { - err = 0; - mattype.mark_as_unsymmetric (); - typ = MatrixType::Tridiagonal; - } - } + { + OCTAVE_LOCAL_BUFFER (double, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = std::real(data(ii++)); + DL[j] = data(ii); + ii += 2; + } + D[nc-1] = std::real(data(ii)); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = std::real (data(i)); + else if (ridx(i) == j + 1) + DL[j] = data(i); + } + } + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols(); + rcond = 1.; + + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, + b_nr, err)); + + if (err != 0) + { + err = 0; + mattype.mark_as_unsymmetric (); + typ = MatrixType::Tridiagonal; + } + } if (typ == MatrixType::Tridiagonal) - { - OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (Complex, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = data(ii++); - DL[j] = data(ii++); - DU[j] = data(ii++); - } - D[nc-1] = data(ii); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - DU[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = data(i); - else if (ridx(i) == j + 1) - DL[j] = data(i); - else if (ridx(i) == j - 1) - DU[j-1] = data(i); - } - } - - octave_idx_type b_nr = b.rows(); - octave_idx_type b_nc = b.cols(); - rcond = 1.; - - retval = ComplexMatrix (b); - Complex *result = retval.fortran_vec (); - - F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, - b_nr, err)); - - if (err != 0) - { - rcond = 0.; - err = -2; - - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - } - } + { + OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (Complex, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = data(ii++); + DL[j] = data(ii++); + DU[j] = data(ii++); + } + D[nc-1] = data(ii); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + DU[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = data(i); + else if (ridx(i) == j + 1) + DL[j] = data(i); + else if (ridx(i) == j - 1) + DU[j-1] = data(i); + } + } + + octave_idx_type b_nr = b.rows(); + octave_idx_type b_nc = b.cols(); + rcond = 1.; + + retval = ComplexMatrix (b); + Complex *result = retval.fortran_vec (); + + F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, + b_nr, err)); + + if (err != 0) + { + rcond = 0.; + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision"); + } + } else if (typ != MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4189,10 +4189,10 @@ SparseComplexMatrix SparseComplexMatrix::trisolve (MatrixType &mattype, - const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + const SparseComplexMatrix& b, + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -4216,131 +4216,131 @@ // Note can't treat symmetric case as there is no dpttrf function if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); - OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (Complex, D, nr); - OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - if (mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < nc-1; j++) - { - D[j] = data(ii++); - DL[j] = data(ii++); - DU[j] = data(ii++); - } - D[nc-1] = data(ii); - } - else - { - D[0] = 0.; - for (octave_idx_type i = 0; i < nr - 1; i++) - { - D[i+1] = 0.; - DL[i] = 0.; - DU[i] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - if (ridx(i) == j) - D[j] = data(i); - else if (ridx(i) == j + 1) - DL[j] = data(i); - else if (ridx(i) == j - 1) - DU[j-1] = data(i); - } - } - - F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); - - 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"); - } - else - { - rcond = 1.; - char job = 'N'; - 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 (i,j); - - F77_XFCN (zgttrs, ZGTTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, 1, DL, D, DU, DU2, pipvt, - Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::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; - } - - 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 (); - } - } + typ == MatrixType::Tridiagonal_Hermitian) + { + OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); + OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (Complex, D, nr); + OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + if (mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < nc-1; j++) + { + D[j] = data(ii++); + DL[j] = data(ii++); + DU[j] = data(ii++); + } + D[nc-1] = data(ii); + } + else + { + D[0] = 0.; + for (octave_idx_type i = 0; i < nr - 1; i++) + { + D[i+1] = 0.; + DL[i] = 0.; + DU[i] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + if (ridx(i) == j) + D[j] = data(i); + else if (ridx(i) == j + 1) + DL[j] = data(i); + else if (ridx(i) == j - 1) + DU[j-1] = data(i); + } + } + + F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); + + 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"); + } + else + { + rcond = 1.; + char job = 'N'; + 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 (i,j); + + F77_XFCN (zgttrs, ZGTTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, 1, DL, D, DU, DU2, pipvt, + Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::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; + } + + 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 (); + } + } else if (typ != MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4348,9 +4348,9 @@ ComplexMatrix SparseComplexMatrix::bsolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4370,225 +4370,225 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ri = ridx (i); - if (ri >= j) - 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 - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - rcond = 0.0; - // Matrix is not positive definite!! Fall through to - // unsymmetric banded solver. - mattype.mark_as_unsymmetric (); - typ = MatrixType::Banded; - err = 0; - } - else - { - 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 (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 (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - } - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ri = ridx (i); + if (ri >= j) + 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 + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + rcond = 0.0; + // Matrix is not positive definite!! Fall through to + // unsymmetric banded solver. + mattype.mark_as_unsymmetric (); + typ = MatrixType::Banded; + err = 0; + } + else + { + 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 (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 (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + } + } + } + } if (typ == MatrixType::Banded) - { - // Create the storage for the banded form of the sparse matrix - octave_idx_type n_upper = mattype.nupper (); - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_upper + 2 * n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - 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 (); - - F77_XFCN (zgbtrf, ZGBTRF, (nr, nc, n_lower, n_upper, tmp_data, - ldm, pipvt, err)); - - // Throw-away extra info LAPACK gives so as to not - // change output. - 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"); - } - else - { - 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 (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))); - } - } - } + { + // Create the storage for the banded form of the sparse matrix + octave_idx_type n_upper = mattype.nupper (); + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_upper + 2 * n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + 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 (); + + F77_XFCN (zgbtrf, ZGBTRF, (nr, nc, n_lower, n_upper, tmp_data, + ldm, pipvt, err)); + + // Throw-away extra info LAPACK gives so as to not + // change output. + 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"); + } + else + { + 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 (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))); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4596,9 +4596,9 @@ SparseComplexMatrix SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -4618,295 +4618,295 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ri = ridx (i); - if (ri >= j) - 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 - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - rcond = 0.0; - mattype.mark_as_unsymmetric (); - typ = MatrixType::Banded; - err = 0; - } - else - { - 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 (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++) - { - 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 (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 (); - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ri = ridx (i); + if (ri >= j) + 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 + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + rcond = 0.0; + mattype.mark_as_unsymmetric (); + typ = MatrixType::Banded; + err = 0; + } + else + { + 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 (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++) + { + 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 (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 (); + } + } + } if (typ == MatrixType::Banded) - { - // Create the storage for the banded form of the sparse matrix - octave_idx_type n_upper = mattype.nupper (); - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_upper + 2 * n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - 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 (); - - F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, - ldm, pipvt, err)); - - 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"); - - } - else - { - 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 (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++) - { - 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))); - - // 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 (); - } - } - } + { + // Create the storage for the banded form of the sparse matrix + octave_idx_type n_upper = mattype.nupper (); + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_upper + 2 * n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + 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 (); + + F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, + ldm, pipvt, err)); + + 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"); + + } + else + { + 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 (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++) + { + 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))); + + // 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 (); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4914,9 +4914,9 @@ ComplexMatrix SparseComplexMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -4936,223 +4936,223 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ri = ridx (i); - if (ri >= j) - 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 - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - // Matrix is not positive definite!! Fall through to - // unsymmetric banded solver. - rcond = 0.0; - mattype.mark_as_unsymmetric (); - typ = MatrixType::Banded; - err = 0; - } - else - { - 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 (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 (err != 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - err = -1; - } - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ri = ridx (i); + if (ri >= j) + 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 + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + // Matrix is not positive definite!! Fall through to + // unsymmetric banded solver. + rcond = 0.0; + mattype.mark_as_unsymmetric (); + typ = MatrixType::Banded; + err = 0; + } + else + { + 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 (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 (err != 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + err = -1; + } + } + } + } if (typ == MatrixType::Banded) - { - // Create the storage for the banded form of the sparse matrix - octave_idx_type n_upper = mattype.nupper (); - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_upper + 2 * n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - 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 (); - - F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, - ldm, pipvt, err)); - - 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"); - } - else - { - 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 (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))); - } - } - } + { + // Create the storage for the banded form of the sparse matrix + octave_idx_type n_upper = mattype.nupper (); + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_upper + 2 * n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + 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 (); + + F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, + ldm, pipvt, err)); + + 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"); + } + else + { + 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 (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))); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -5160,9 +5160,9 @@ SparseComplexMatrix SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -5182,304 +5182,304 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - octave_idx_type ri = ridx (i); - if (ri >= j) - 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 - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - // Matrix is not positive definite!! Fall through to - // unsymmetric banded solver. - mattype.mark_as_unsymmetric (); - typ = MatrixType::Banded; - - rcond = 0.0; - err = 0; - } - else - { - 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 (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++) - { - - 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 (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; - } - - 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 (); - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + octave_idx_type ri = ridx (i); + if (ri >= j) + 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 + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + // Matrix is not positive definite!! Fall through to + // unsymmetric banded solver. + mattype.mark_as_unsymmetric (); + typ = MatrixType::Banded; + + rcond = 0.0; + err = 0; + } + else + { + 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 (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++) + { + + 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 (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; + } + + 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 (); + } + } + } if (typ == MatrixType::Banded) - { - // Create the storage for the banded form of the sparse matrix - octave_idx_type n_upper = mattype.nupper (); - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_upper + 2 * n_lower + 1; - - ComplexMatrix m_band (ldm, nc); - Complex *tmp_data = m_band.fortran_vec (); - - if (! mattype.is_dense ()) - { - octave_idx_type ii = 0; - - for (octave_idx_type j = 0; j < ldm; j++) - for (octave_idx_type i = 0; i < nc; i++) - tmp_data[ii++] = 0.; - } - - for (octave_idx_type j = 0; j < nc; j++) - 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 (); - - F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, - ldm, pipvt, err)); - - 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"); - - } - else - { - 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 (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++) - { - 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))); - - // 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 (); - } - } - } + { + // Create the storage for the banded form of the sparse matrix + octave_idx_type n_upper = mattype.nupper (); + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_upper + 2 * n_lower + 1; + + ComplexMatrix m_band (ldm, nc); + Complex *tmp_data = m_band.fortran_vec (); + + if (! mattype.is_dense ()) + { + octave_idx_type ii = 0; + + for (octave_idx_type j = 0; j < ldm; j++) + for (octave_idx_type i = 0; i < nc; i++) + tmp_data[ii++] = 0.; + } + + for (octave_idx_type j = 0; j < nc; j++) + 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 (); + + F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, + ldm, pipvt, err)); + + 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"); + + } + else + { + 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 (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++) + { + 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))); + + // 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 (); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -5487,9 +5487,9 @@ void * SparseComplexMatrix::factorize (octave_idx_type& err, double &rcond, - Matrix &Control, Matrix &Info, - solve_singularity_handler sing_handler, - bool calc_cond) const + Matrix &Control, Matrix &Info, + solve_singularity_handler sing_handler, + bool calc_cond) const { // The return values void *Numeric = 0; @@ -5525,20 +5525,20 @@ octave_idx_type nc = cols (); UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, 1, control); + reinterpret_cast<const double *> (Ax), + 0, 1, control); void *Symbolic; Info = Matrix (1, UMFPACK_INFO); double *info = Info.fortran_vec (); int status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, 0, &Symbolic, control, info); + reinterpret_cast<const double *> (Ax), + 0, 0, &Symbolic, control, info); if (status < 0) { (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve symbolic factorization failed"); + ("SparseComplexMatrix::solve symbolic factorization failed"); err = -1; UMFPACK_ZNAME (report_status) (control, status); @@ -5551,45 +5551,45 @@ UMFPACK_ZNAME (report_symbolic) (Symbolic, control); status = UMFPACK_ZNAME (numeric) (Ap, Ai, - reinterpret_cast<const double *> (Ax), 0, - Symbolic, &Numeric, control, info) ; + reinterpret_cast<const double *> (Ax), 0, + Symbolic, &Numeric, control, info) ; UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; if (calc_cond) - rcond = Info (UMFPACK_RCOND); + rcond = Info (UMFPACK_RCOND); else - rcond = 1.; + rcond = 1.; volatile double rcond_plus_one = rcond + 1.0; if (status == UMFPACK_WARNING_singular_matrix || - rcond_plus_one == 1.0 || xisnan (rcond)) - { - UMFPACK_ZNAME (report_numeric) (Numeric, control); - - err = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - } + rcond_plus_one == 1.0 || xisnan (rcond)) + { + UMFPACK_ZNAME (report_numeric) (Numeric, control); + + err = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + } else if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve numeric factorization failed"); - - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); - - err = -1; - } - else - { - UMFPACK_ZNAME (report_numeric) (Numeric, control); - } + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve numeric factorization failed"); + + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); + + err = -1; + } + else + { + UMFPACK_ZNAME (report_numeric) (Numeric, control); + } } if (err != 0) @@ -5603,9 +5603,9 @@ ComplexMatrix SparseComplexMatrix::fsolve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -5625,220 +5625,220 @@ mattype.info (); if (typ == MatrixType::Hermitian) - { + { #ifdef HAVE_CHOLMOD - cholmod_common Common; - cholmod_common *cm = &Common; - - // Setup initial parameters - CHOLMOD_NAME(start) (cm); - cm->prefer_zomplex = false; - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast<int> (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - cm->final_ll = true; - - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - double dummy; - A->nrow = nr; - A->ncol = nc; - - A->p = cidx(); - A->i = ridx(); - A->nzmax = nnz(); - A->packed = true; - A->sorted = true; - A->nz = 0; + cholmod_common Common; + cholmod_common *cm = &Common; + + // Setup initial parameters + CHOLMOD_NAME(start) (cm); + cm->prefer_zomplex = false; + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast<int> (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + cm->final_ll = true; + + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + double dummy; + A->nrow = nr; + A->ncol = nc; + + A->p = cidx(); + A->i = ridx(); + A->nzmax = nnz(); + A->packed = true; + A->sorted = true; + A->nz = 0; #ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; + A->itype = CHOLMOD_LONG; #else - A->itype = CHOLMOD_INT; + A->itype = CHOLMOD_INT; #endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->xtype = CHOLMOD_COMPLEX; - - if (nr < 1) - A->x = &dummy; - else - A->x = data(); - - cholmod_dense Bstore; - cholmod_dense *B = &Bstore; - B->nrow = b.rows(); - B->ncol = b.cols(); - B->d = B->nrow; - B->nzmax = B->nrow * B->ncol; - B->dtype = CHOLMOD_DOUBLE; - B->xtype = CHOLMOD_REAL; - if (nc < 1 || b.cols() < 1) - B->x = &dummy; - else - // We won't alter it, honest :-) - B->x = const_cast<double *>(b.fortran_vec()); - - cholmod_factor *L; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - L = CHOLMOD_NAME(analyze) (A, cm); - CHOLMOD_NAME(factorize) (A, L, cm); - if (calc_cond) - rcond = CHOLMOD_NAME(rcond)(L, cm); - else - rcond = 1.; - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (rcond == 0.0) - { - // Either its indefinite or singular. Try UMFPACK - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - 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) - ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - return retval; - } - - cholmod_dense *X; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - retval.resize (b.rows (), b.cols()); - for (octave_idx_type j = 0; j < b.cols(); j++) - { - octave_idx_type jr = j * b.rows(); - for (octave_idx_type i = 0; i < b.rows(); i++) - retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(free_dense) (&X, cm); - CHOLMOD_NAME(free_factor) (&L, cm); - CHOLMOD_NAME(finish) (cm); - static char tmp[] = " "; - CHOLMOD_NAME(print_common) (tmp, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->xtype = CHOLMOD_COMPLEX; + + if (nr < 1) + A->x = &dummy; + else + A->x = data(); + + cholmod_dense Bstore; + cholmod_dense *B = &Bstore; + B->nrow = b.rows(); + B->ncol = b.cols(); + B->d = B->nrow; + B->nzmax = B->nrow * B->ncol; + B->dtype = CHOLMOD_DOUBLE; + B->xtype = CHOLMOD_REAL; + if (nc < 1 || b.cols() < 1) + B->x = &dummy; + else + // We won't alter it, honest :-) + B->x = const_cast<double *>(b.fortran_vec()); + + cholmod_factor *L; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + L = CHOLMOD_NAME(analyze) (A, cm); + CHOLMOD_NAME(factorize) (A, L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + if (rcond == 0.0) + { + // Either its indefinite or singular. Try UMFPACK + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + 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) + ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + return retval; + } + + cholmod_dense *X; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + retval.resize (b.rows (), b.cols()); + for (octave_idx_type j = 0; j < b.cols(); j++) + { + octave_idx_type jr = j * b.rows(); + for (octave_idx_type i = 0; i < b.rows(); i++) + retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(free_dense) (&X, cm); + CHOLMOD_NAME(free_factor) (&L, cm); + CHOLMOD_NAME(finish) (cm); + static char tmp[] = " "; + CHOLMOD_NAME(print_common) (tmp, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } #else - (*current_liboctave_warning_handler) - ("CHOLMOD not installed"); - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; + (*current_liboctave_warning_handler) + ("CHOLMOD not installed"); + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; #endif - } + } if (typ == MatrixType::Full) - { + { #ifdef HAVE_UMFPACK - Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, - sing_handler, calc_cond); - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - int status = 0; - double *control = Control.fortran_vec (); - double *info = Info.fortran_vec (); - const octave_idx_type *Ap = cidx (); - const octave_idx_type *Ai = ridx (); - const Complex *Ax = data (); + Matrix Control, Info; + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + int status = 0; + double *control = Control.fortran_vec (); + double *info = Info.fortran_vec (); + const octave_idx_type *Ap = cidx (); + const octave_idx_type *Ai = ridx (); + const Complex *Ax = data (); #ifdef UMFPACK_SEPARATE_SPLIT - const double *Bx = b.fortran_vec (); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - for (octave_idx_type i = 0; i < b_nr; i++) - Bz[i] = 0.; + const double *Bx = b.fortran_vec (); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + for (octave_idx_type i = 0; i < b_nr; i++) + Bz[i] = 0.; #else - OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); + OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); #endif - retval.resize (b_nr, b_nc); - Complex *Xx = retval.fortran_vec (); - - for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) - { + retval.resize (b_nr, b_nc); + Complex *Xx = retval.fortran_vec (); + + for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) + { #ifdef UMFPACK_SEPARATE_SPLIT - status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, - Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (&Xx[iidx]), - 0, - &Bx[iidx], Bz, Numeric, - control, info); + status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, + Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (&Xx[iidx]), + 0, + &Bx[iidx], Bz, Numeric, + control, info); #else - for (octave_idx_type i = 0; i < b_nr; i++) - Bz[i] = b.elem (i, j); - - status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, - Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (&Xx[iidx]), - 0, - reinterpret_cast<const double *> (Bz), - 0, Numeric, - control, info); + for (octave_idx_type i = 0; i < b_nr; i++) + Bz[i] = b.elem (i, j); + + status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, + Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (&Xx[iidx]), + 0, + reinterpret_cast<const double *> (Bz), + 0, Numeric, + control, info); #endif - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - - UMFPACK_ZNAME (report_status) (control, status); - - err = -1; - - break; - } - } - - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - mattype.mark_as_rectangular (); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + + UMFPACK_ZNAME (report_status) (control, status); + + err = -1; + + break; + } + } + + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + mattype.mark_as_rectangular (); #else - (*current_liboctave_error_handler) ("UMFPACK not installed"); + (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif - } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -5846,9 +5846,9 @@ SparseComplexMatrix SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -5868,268 +5868,268 @@ mattype.info (); if (typ == MatrixType::Hermitian) - { + { #ifdef HAVE_CHOLMOD - cholmod_common Common; - cholmod_common *cm = &Common; - - // Setup initial parameters - CHOLMOD_NAME(start) (cm); - cm->prefer_zomplex = false; - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast<int> (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - cm->final_ll = true; - - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - double dummy; - A->nrow = nr; - A->ncol = nc; - - A->p = cidx(); - A->i = ridx(); - A->nzmax = nnz(); - A->packed = true; - A->sorted = true; - A->nz = 0; + cholmod_common Common; + cholmod_common *cm = &Common; + + // Setup initial parameters + CHOLMOD_NAME(start) (cm); + cm->prefer_zomplex = false; + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast<int> (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + cm->final_ll = true; + + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + double dummy; + A->nrow = nr; + A->ncol = nc; + + A->p = cidx(); + A->i = ridx(); + A->nzmax = nnz(); + A->packed = true; + A->sorted = true; + A->nz = 0; #ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; + A->itype = CHOLMOD_LONG; #else - A->itype = CHOLMOD_INT; + A->itype = CHOLMOD_INT; #endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->xtype = CHOLMOD_COMPLEX; - - if (nr < 1) - A->x = &dummy; - else - A->x = data(); - - cholmod_sparse Bstore; - cholmod_sparse *B = &Bstore; - B->nrow = b.rows(); - B->ncol = b.cols(); - B->p = b.cidx(); - B->i = b.ridx(); - B->nzmax = b.nnz(); - B->packed = true; - B->sorted = true; - B->nz = 0; + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->xtype = CHOLMOD_COMPLEX; + + if (nr < 1) + A->x = &dummy; + else + A->x = data(); + + cholmod_sparse Bstore; + cholmod_sparse *B = &Bstore; + B->nrow = b.rows(); + B->ncol = b.cols(); + B->p = b.cidx(); + B->i = b.ridx(); + B->nzmax = b.nnz(); + B->packed = true; + B->sorted = true; + B->nz = 0; #ifdef IDX_TYPE_LONG - B->itype = CHOLMOD_LONG; + B->itype = CHOLMOD_LONG; #else - B->itype = CHOLMOD_INT; + B->itype = CHOLMOD_INT; #endif - B->dtype = CHOLMOD_DOUBLE; - B->stype = 0; - B->xtype = CHOLMOD_REAL; - - if (b.rows() < 1 || b.cols() < 1) - B->x = &dummy; - else - B->x = b.data(); - - cholmod_factor *L; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - L = CHOLMOD_NAME(analyze) (A, cm); - CHOLMOD_NAME(factorize) (A, L, cm); - if (calc_cond) - rcond = CHOLMOD_NAME(rcond)(L, cm); - else - rcond = 1.; - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (rcond == 0.0) - { - // Either its indefinite or singular. Try UMFPACK - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - 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) - ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - return retval; - } - - cholmod_sparse *X; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - retval = SparseComplexMatrix - (static_cast<octave_idx_type>(X->nrow), - static_cast<octave_idx_type>(X->ncol), - static_cast<octave_idx_type>(X->nzmax)); - for (octave_idx_type j = 0; - j <= static_cast<octave_idx_type>(X->ncol); j++) - retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; - for (octave_idx_type j = 0; - j < static_cast<octave_idx_type>(X->nzmax); j++) - { - retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; - retval.xdata(j) = static_cast<Complex *>(X->x)[j]; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(free_sparse) (&X, cm); - CHOLMOD_NAME(free_factor) (&L, cm); - CHOLMOD_NAME(finish) (cm); - static char tmp[] = " "; - CHOLMOD_NAME(print_common) (tmp, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + B->dtype = CHOLMOD_DOUBLE; + B->stype = 0; + B->xtype = CHOLMOD_REAL; + + if (b.rows() < 1 || b.cols() < 1) + B->x = &dummy; + else + B->x = b.data(); + + cholmod_factor *L; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + L = CHOLMOD_NAME(analyze) (A, cm); + CHOLMOD_NAME(factorize) (A, L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + if (rcond == 0.0) + { + // Either its indefinite or singular. Try UMFPACK + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + 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) + ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + return retval; + } + + cholmod_sparse *X; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + retval = SparseComplexMatrix + (static_cast<octave_idx_type>(X->nrow), + static_cast<octave_idx_type>(X->ncol), + static_cast<octave_idx_type>(X->nzmax)); + for (octave_idx_type j = 0; + j <= static_cast<octave_idx_type>(X->ncol); j++) + retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; + for (octave_idx_type j = 0; + j < static_cast<octave_idx_type>(X->nzmax); j++) + { + retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; + retval.xdata(j) = static_cast<Complex *>(X->x)[j]; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(free_sparse) (&X, cm); + CHOLMOD_NAME(free_factor) (&L, cm); + CHOLMOD_NAME(finish) (cm); + static char tmp[] = " "; + CHOLMOD_NAME(print_common) (tmp, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } #else - (*current_liboctave_warning_handler) - ("CHOLMOD not installed"); - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; + (*current_liboctave_warning_handler) + ("CHOLMOD not installed"); + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; #endif - } + } if (typ == MatrixType::Full) - { + { #ifdef HAVE_UMFPACK - Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, - sing_handler, calc_cond); - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - int status = 0; - double *control = Control.fortran_vec (); - double *info = Info.fortran_vec (); - const octave_idx_type *Ap = cidx (); - const octave_idx_type *Ai = ridx (); - const Complex *Ax = data (); + Matrix Control, Info; + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + int status = 0; + double *control = Control.fortran_vec (); + double *info = Info.fortran_vec (); + const octave_idx_type *Ap = cidx (); + const octave_idx_type *Ai = ridx (); + const Complex *Ax = data (); #ifdef UMFPACK_SEPARATE_SPLIT - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - for (octave_idx_type i = 0; i < b_nr; i++) - Bz[i] = 0.; + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + for (octave_idx_type i = 0; i < b_nr; i++) + Bz[i] = 0.; #else - OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); + OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); #endif - // Take a first guess that the number of non-zero terms - // will be as many as in b - octave_idx_type x_nz = b.nnz (); - octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); - - retval.xcidx(0) = 0; - for (octave_idx_type j = 0; j < b_nc; j++) - { + // Take a first guess that the number of non-zero terms + // will be as many as in b + octave_idx_type x_nz = b.nnz (); + octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); + + retval.xcidx(0) = 0; + for (octave_idx_type j = 0; j < b_nc; j++) + { #ifdef UMFPACK_SEPARATE_SPLIT - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b.elem (i, j); - - status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, - Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (Xx), - 0, - Bx, Bz, Numeric, control, - info); + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b.elem (i, j); + + status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, + Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (Xx), + 0, + Bx, Bz, Numeric, control, + info); #else - for (octave_idx_type i = 0; i < b_nr; i++) - Bz[i] = b.elem (i, j); - - status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (Xx), - 0, - reinterpret_cast<double *> (Bz), - 0, - Numeric, control, - info); + for (octave_idx_type i = 0; i < b_nr; i++) + Bz[i] = b.elem (i, j); + + status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (Xx), + 0, + reinterpret_cast<double *> (Bz), + 0, + Numeric, control, + info); #endif - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - - UMFPACK_ZNAME (report_status) (control, status); - - err = -1; - - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex tmp = Xx[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 (); - - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - mattype.mark_as_rectangular (); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + + UMFPACK_ZNAME (report_status) (control, status); + + err = -1; + + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex tmp = Xx[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 (); + + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + mattype.mark_as_rectangular (); #else - (*current_liboctave_error_handler) ("UMFPACK not installed"); + (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif - } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -6137,9 +6137,9 @@ ComplexMatrix SparseComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { ComplexMatrix retval; @@ -6159,199 +6159,199 @@ mattype.info (); if (typ == MatrixType::Hermitian) - { + { #ifdef HAVE_CHOLMOD - cholmod_common Common; - cholmod_common *cm = &Common; - - // Setup initial parameters - CHOLMOD_NAME(start) (cm); - cm->prefer_zomplex = false; - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast<int> (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - cm->final_ll = true; - - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - double dummy; - A->nrow = nr; - A->ncol = nc; - - A->p = cidx(); - A->i = ridx(); - A->nzmax = nnz(); - A->packed = true; - A->sorted = true; - A->nz = 0; + cholmod_common Common; + cholmod_common *cm = &Common; + + // Setup initial parameters + CHOLMOD_NAME(start) (cm); + cm->prefer_zomplex = false; + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast<int> (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + cm->final_ll = true; + + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + double dummy; + A->nrow = nr; + A->ncol = nc; + + A->p = cidx(); + A->i = ridx(); + A->nzmax = nnz(); + A->packed = true; + A->sorted = true; + A->nz = 0; #ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; + A->itype = CHOLMOD_LONG; #else - A->itype = CHOLMOD_INT; + A->itype = CHOLMOD_INT; #endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->xtype = CHOLMOD_COMPLEX; - - if (nr < 1) - A->x = &dummy; - else - A->x = data(); - - cholmod_dense Bstore; - cholmod_dense *B = &Bstore; - B->nrow = b.rows(); - B->ncol = b.cols(); - B->d = B->nrow; - B->nzmax = B->nrow * B->ncol; - B->dtype = CHOLMOD_DOUBLE; - B->xtype = CHOLMOD_COMPLEX; - if (nc < 1 || b.cols() < 1) - B->x = &dummy; - else - // We won't alter it, honest :-) - B->x = const_cast<Complex *>(b.fortran_vec()); - - cholmod_factor *L; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - L = CHOLMOD_NAME(analyze) (A, cm); - CHOLMOD_NAME(factorize) (A, L, cm); - if (calc_cond) - rcond = CHOLMOD_NAME(rcond)(L, cm); - else - rcond = 1.; - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (rcond == 0.0) - { - // Either its indefinite or singular. Try UMFPACK - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - 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) - ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - return retval; - } - - cholmod_dense *X; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - retval.resize (b.rows (), b.cols()); - for (octave_idx_type j = 0; j < b.cols(); j++) - { - octave_idx_type jr = j * b.rows(); - for (octave_idx_type i = 0; i < b.rows(); i++) - retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(free_dense) (&X, cm); - CHOLMOD_NAME(free_factor) (&L, cm); - CHOLMOD_NAME(finish) (cm); - static char tmp[] = " "; - CHOLMOD_NAME(print_common) (tmp, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->xtype = CHOLMOD_COMPLEX; + + if (nr < 1) + A->x = &dummy; + else + A->x = data(); + + cholmod_dense Bstore; + cholmod_dense *B = &Bstore; + B->nrow = b.rows(); + B->ncol = b.cols(); + B->d = B->nrow; + B->nzmax = B->nrow * B->ncol; + B->dtype = CHOLMOD_DOUBLE; + B->xtype = CHOLMOD_COMPLEX; + if (nc < 1 || b.cols() < 1) + B->x = &dummy; + else + // We won't alter it, honest :-) + B->x = const_cast<Complex *>(b.fortran_vec()); + + cholmod_factor *L; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + L = CHOLMOD_NAME(analyze) (A, cm); + CHOLMOD_NAME(factorize) (A, L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + if (rcond == 0.0) + { + // Either its indefinite or singular. Try UMFPACK + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + 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) + ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + return retval; + } + + cholmod_dense *X; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + retval.resize (b.rows (), b.cols()); + for (octave_idx_type j = 0; j < b.cols(); j++) + { + octave_idx_type jr = j * b.rows(); + for (octave_idx_type i = 0; i < b.rows(); i++) + retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(free_dense) (&X, cm); + CHOLMOD_NAME(free_factor) (&L, cm); + CHOLMOD_NAME(finish) (cm); + static char tmp[] = " "; + CHOLMOD_NAME(print_common) (tmp, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } #else - (*current_liboctave_warning_handler) - ("CHOLMOD not installed"); - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; + (*current_liboctave_warning_handler) + ("CHOLMOD not installed"); + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; #endif - } + } if (typ == MatrixType::Full) - { + { #ifdef HAVE_UMFPACK - Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, - sing_handler, calc_cond); - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - int status = 0; - double *control = Control.fortran_vec (); - double *info = Info.fortran_vec (); - const octave_idx_type *Ap = cidx (); - const octave_idx_type *Ai = ridx (); - const Complex *Ax = data (); - const Complex *Bx = b.fortran_vec (); - - retval.resize (b_nr, b_nc); - Complex *Xx = retval.fortran_vec (); - - for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) - { - status = - UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (&Xx[iidx]), - 0, - reinterpret_cast<const double *> (&Bx[iidx]), - 0, Numeric, control, info); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - - UMFPACK_ZNAME (report_status) (control, status); - - err = -1; - - break; - } - } - - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - mattype.mark_as_rectangular (); + Matrix Control, Info; + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + int status = 0; + double *control = Control.fortran_vec (); + double *info = Info.fortran_vec (); + const octave_idx_type *Ap = cidx (); + const octave_idx_type *Ai = ridx (); + const Complex *Ax = data (); + const Complex *Bx = b.fortran_vec (); + + retval.resize (b_nr, b_nc); + Complex *Xx = retval.fortran_vec (); + + for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) + { + status = + UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (&Xx[iidx]), + 0, + reinterpret_cast<const double *> (&Bx[iidx]), + 0, Numeric, control, info); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + + UMFPACK_ZNAME (report_status) (control, status); + + err = -1; + + break; + } + } + + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + mattype.mark_as_rectangular (); #else - (*current_liboctave_error_handler) ("UMFPACK not installed"); + (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif - } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -6359,9 +6359,9 @@ SparseComplexMatrix SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const { SparseComplexMatrix retval; @@ -6381,263 +6381,263 @@ mattype.info (); if (typ == MatrixType::Hermitian) - { + { #ifdef HAVE_CHOLMOD - cholmod_common Common; - cholmod_common *cm = &Common; - - // Setup initial parameters - CHOLMOD_NAME(start) (cm); - cm->prefer_zomplex = false; - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast<int> (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - cm->final_ll = true; - - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - double dummy; - A->nrow = nr; - A->ncol = nc; - - A->p = cidx(); - A->i = ridx(); - A->nzmax = nnz(); - A->packed = true; - A->sorted = true; - A->nz = 0; + cholmod_common Common; + cholmod_common *cm = &Common; + + // Setup initial parameters + CHOLMOD_NAME(start) (cm); + cm->prefer_zomplex = false; + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast<int> (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + cm->final_ll = true; + + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + double dummy; + A->nrow = nr; + A->ncol = nc; + + A->p = cidx(); + A->i = ridx(); + A->nzmax = nnz(); + A->packed = true; + A->sorted = true; + A->nz = 0; #ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; + A->itype = CHOLMOD_LONG; #else - A->itype = CHOLMOD_INT; + A->itype = CHOLMOD_INT; #endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->xtype = CHOLMOD_COMPLEX; - - if (nr < 1) - A->x = &dummy; - else - A->x = data(); - - cholmod_sparse Bstore; - cholmod_sparse *B = &Bstore; - B->nrow = b.rows(); - B->ncol = b.cols(); - B->p = b.cidx(); - B->i = b.ridx(); - B->nzmax = b.nnz(); - B->packed = true; - B->sorted = true; - B->nz = 0; + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->xtype = CHOLMOD_COMPLEX; + + if (nr < 1) + A->x = &dummy; + else + A->x = data(); + + cholmod_sparse Bstore; + cholmod_sparse *B = &Bstore; + B->nrow = b.rows(); + B->ncol = b.cols(); + B->p = b.cidx(); + B->i = b.ridx(); + B->nzmax = b.nnz(); + B->packed = true; + B->sorted = true; + B->nz = 0; #ifdef IDX_TYPE_LONG - B->itype = CHOLMOD_LONG; + B->itype = CHOLMOD_LONG; #else - B->itype = CHOLMOD_INT; + B->itype = CHOLMOD_INT; #endif - B->dtype = CHOLMOD_DOUBLE; - B->stype = 0; - B->xtype = CHOLMOD_COMPLEX; - - if (b.rows() < 1 || b.cols() < 1) - B->x = &dummy; - else - B->x = b.data(); - - cholmod_factor *L; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - L = CHOLMOD_NAME(analyze) (A, cm); - CHOLMOD_NAME(factorize) (A, L, cm); - if (calc_cond) - rcond = CHOLMOD_NAME(rcond)(L, cm); - else - rcond = 1.; - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (rcond == 0.0) - { - // Either its indefinite or singular. Try UMFPACK - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - else - { - 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) - ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - return retval; - } - - cholmod_sparse *X; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - retval = SparseComplexMatrix - (static_cast<octave_idx_type>(X->nrow), - static_cast<octave_idx_type>(X->ncol), - static_cast<octave_idx_type>(X->nzmax)); - for (octave_idx_type j = 0; - j <= static_cast<octave_idx_type>(X->ncol); j++) - retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; - for (octave_idx_type j = 0; - j < static_cast<octave_idx_type>(X->nzmax); j++) - { - retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; - retval.xdata(j) = static_cast<Complex *>(X->x)[j]; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(free_sparse) (&X, cm); - CHOLMOD_NAME(free_factor) (&L, cm); - CHOLMOD_NAME(finish) (cm); - static char tmp[] = " "; - CHOLMOD_NAME(print_common) (tmp, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + B->dtype = CHOLMOD_DOUBLE; + B->stype = 0; + B->xtype = CHOLMOD_COMPLEX; + + if (b.rows() < 1 || b.cols() < 1) + B->x = &dummy; + else + B->x = b.data(); + + cholmod_factor *L; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + L = CHOLMOD_NAME(analyze) (A, cm); + CHOLMOD_NAME(factorize) (A, L, cm); + if (calc_cond) + rcond = CHOLMOD_NAME(rcond)(L, cm); + else + rcond = 1.; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + if (rcond == 0.0) + { + // Either its indefinite or singular. Try UMFPACK + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + 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) + ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + return retval; + } + + cholmod_sparse *X; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + retval = SparseComplexMatrix + (static_cast<octave_idx_type>(X->nrow), + static_cast<octave_idx_type>(X->ncol), + static_cast<octave_idx_type>(X->nzmax)); + for (octave_idx_type j = 0; + j <= static_cast<octave_idx_type>(X->ncol); j++) + retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; + for (octave_idx_type j = 0; + j < static_cast<octave_idx_type>(X->nzmax); j++) + { + retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; + retval.xdata(j) = static_cast<Complex *>(X->x)[j]; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(free_sparse) (&X, cm); + CHOLMOD_NAME(free_factor) (&L, cm); + CHOLMOD_NAME(finish) (cm); + static char tmp[] = " "; + CHOLMOD_NAME(print_common) (tmp, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } #else - (*current_liboctave_warning_handler) - ("CHOLMOD not installed"); - - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; + (*current_liboctave_warning_handler) + ("CHOLMOD not installed"); + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; #endif - } + } if (typ == MatrixType::Full) - { + { #ifdef HAVE_UMFPACK - Matrix Control, Info; - void *Numeric = factorize (err, rcond, Control, Info, - sing_handler, calc_cond); - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - int status = 0; - double *control = Control.fortran_vec (); - double *info = Info.fortran_vec (); - const octave_idx_type *Ap = cidx (); - const octave_idx_type *Ai = ridx (); - const Complex *Ax = data (); - - 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 - octave_idx_type x_nz = b.nnz (); - octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); - - retval.xcidx(0) = 0; - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b (i,j); - - status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, - Ai, - reinterpret_cast<const double *> (Ax), - 0, - reinterpret_cast<double *> (Xx), - 0, - reinterpret_cast<double *> (Bx), - 0, Numeric, control, info); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve solve failed"); - - UMFPACK_ZNAME (report_status) (control, status); - - err = -1; - - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex tmp = Xx[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 (); - - rcond = Info (UMFPACK_RCOND); - volatile double rcond_plus_one = rcond + 1.0; - - if (status == UMFPACK_WARNING_singular_matrix || - rcond_plus_one == 1.0 || xisnan (rcond)) - { - err = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - } - - UMFPACK_ZNAME (report_info) (control, info); - - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - mattype.mark_as_rectangular (); + Matrix Control, Info; + void *Numeric = factorize (err, rcond, Control, Info, + sing_handler, calc_cond); + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + int status = 0; + double *control = Control.fortran_vec (); + double *info = Info.fortran_vec (); + const octave_idx_type *Ap = cidx (); + const octave_idx_type *Ai = ridx (); + const Complex *Ax = data (); + + 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 + octave_idx_type x_nz = b.nnz (); + octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); + + retval.xcidx(0) = 0; + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b (i,j); + + status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, + Ai, + reinterpret_cast<const double *> (Ax), + 0, + reinterpret_cast<double *> (Xx), + 0, + reinterpret_cast<double *> (Bx), + 0, Numeric, control, info); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve solve failed"); + + UMFPACK_ZNAME (report_status) (control, status); + + err = -1; + + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex tmp = Xx[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 (); + + rcond = Info (UMFPACK_RCOND); + volatile double rcond_plus_one = rcond + 1.0; + + if (status == UMFPACK_WARNING_singular_matrix || + rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + } + + UMFPACK_ZNAME (report_info) (control, info); + + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + mattype.mark_as_rectangular (); #else - (*current_liboctave_error_handler) ("UMFPACK not installed"); + (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif - } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -6653,7 +6653,7 @@ ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); @@ -6661,16 +6661,16 @@ ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool singular_fallback) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback) const { ComplexMatrix retval; int typ = mattype.type (false); @@ -6687,7 +6687,7 @@ else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); @@ -6704,7 +6704,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<ComplexMatrix, SparseComplexMatrix, - Matrix> (*this, b, err); + Matrix> (*this, b, err); #endif } @@ -6721,7 +6721,7 @@ SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); @@ -6729,16 +6729,16 @@ SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool singular_fallback) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback) const { SparseComplexMatrix retval; int typ = mattype.type (false); @@ -6755,7 +6755,7 @@ else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); @@ -6772,7 +6772,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, - SparseMatrix> (*this, b, err); + SparseMatrix> (*this, b, err); #endif } @@ -6789,7 +6789,7 @@ ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); @@ -6797,16 +6797,16 @@ ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool singular_fallback) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback) const { ComplexMatrix retval; int typ = mattype.type (false); @@ -6823,7 +6823,7 @@ else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); @@ -6840,7 +6840,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<ComplexMatrix, SparseComplexMatrix, - ComplexMatrix> (*this, b, err); + ComplexMatrix> (*this, b, err); #endif } @@ -6849,7 +6849,7 @@ SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, - const SparseComplexMatrix& b) const + const SparseComplexMatrix& b) const { octave_idx_type info; double rcond; @@ -6858,7 +6858,7 @@ SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); @@ -6866,16 +6866,16 @@ SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseComplexMatrix SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler, - bool singular_fallback) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback) const { SparseComplexMatrix retval; int typ = mattype.type (false); @@ -6892,7 +6892,7 @@ else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); @@ -6909,7 +6909,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, - SparseComplexMatrix> (*this, b, err); + SparseComplexMatrix> (*this, b, err); #endif } @@ -6925,7 +6925,7 @@ ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond); @@ -6933,15 +6933,15 @@ ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, - octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const { Matrix tmp (b); return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -6949,7 +6949,7 @@ ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, - const ComplexColumnVector& b) const + const ComplexColumnVector& b) const { octave_idx_type info; double rcond; @@ -6958,7 +6958,7 @@ ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); @@ -6966,15 +6966,15 @@ ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, - octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const { ComplexMatrix tmp (b); return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -6997,15 +6997,15 @@ ComplexMatrix SparseComplexMatrix::solve (const Matrix& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (b, info, rcond, 0); } ComplexMatrix SparseComplexMatrix::solve (const Matrix& b, octave_idx_type& err, - double& rcond, - solve_singularity_handler sing_handler) const + double& rcond, + solve_singularity_handler sing_handler) const { MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); @@ -7021,7 +7021,7 @@ SparseComplexMatrix SparseComplexMatrix::solve (const SparseMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7029,15 +7029,15 @@ SparseComplexMatrix SparseComplexMatrix::solve (const SparseMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (b, info, rcond, 0); } SparseComplexMatrix SparseComplexMatrix::solve (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) const { MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); @@ -7045,7 +7045,7 @@ ComplexMatrix SparseComplexMatrix::solve (const ComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7053,15 +7053,15 @@ ComplexMatrix SparseComplexMatrix::solve (const ComplexMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (b, info, rcond, 0); } ComplexMatrix SparseComplexMatrix::solve (const ComplexMatrix& b, - octave_idx_type& err, double& rcond, - solve_singularity_handler sing_handler) const + octave_idx_type& err, double& rcond, + solve_singularity_handler sing_handler) const { MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); @@ -7077,7 +7077,7 @@ SparseComplexMatrix SparseComplexMatrix::solve (const SparseComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7085,15 +7085,15 @@ SparseComplexMatrix SparseComplexMatrix::solve (const SparseComplexMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (b, info, rcond, 0); } SparseComplexMatrix SparseComplexMatrix::solve (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) const { MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); @@ -7115,14 +7115,14 @@ ComplexColumnVector SparseComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (b, info, rcond, 0); } ComplexColumnVector SparseComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler) const { Matrix tmp (b); return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -7145,15 +7145,15 @@ ComplexColumnVector SparseComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (b, info, rcond, 0); } ComplexColumnVector SparseComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, - double& rcond, - solve_singularity_handler sing_handler) const + double& rcond, + solve_singularity_handler sing_handler) const { ComplexMatrix tmp (b); return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -7176,15 +7176,15 @@ for (octave_idx_type i = 0; i < nc; i++) { for (octave_idx_type j = 0; j < nr; j++) - { - if (jj < cidx(i+1) && ridx(jj) == j) - jj++; - else - { - r.data(ii) = true; - r.ridx(ii++) = j; - } - } + { + if (jj < cidx(i+1) && ridx(jj) == j) + jj++; + else + { + r.data(ii) = true; + r.ridx(ii++) = j; + } + } r.cidx (i+1) = ii; } @@ -7243,7 +7243,7 @@ { Complex val = data (i); if (xisnan (val)) - return true; + return true; } return false; @@ -7258,7 +7258,7 @@ { Complex val = data (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -7289,25 +7289,25 @@ for (octave_idx_type i = 0; i < nel; i++) { - Complex val = data (i); - - double r_val = std::real (val); - double i_val = std::imag (val); - - if (r_val > max_val) - max_val = r_val; - - if (i_val > max_val) - max_val = i_val; - - if (r_val < min_val) - min_val = r_val; - - if (i_val < min_val) - min_val = i_val; - - if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) - return false; + Complex val = data (i); + + double r_val = std::real (val); + double i_val = std::imag (val); + + if (r_val > max_val) + max_val = r_val; + + if (i_val > max_val) + max_val = i_val; + + if (r_val < min_val) + min_val = r_val; + + if (i_val < min_val) + min_val = i_val; + + if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) + return false; } return true; @@ -7320,16 +7320,16 @@ for (octave_idx_type i = 0; i < nel; i++) { - Complex val = data (i); - - double r_val = std::real (val); - double i_val = std::imag (val); - - if (r_val > FLT_MAX - || i_val > FLT_MAX - || r_val < FLT_MIN - || i_val < FLT_MIN) - return true; + Complex val = data (i); + + double r_val = std::real (val); + double i_val = std::imag (val); + + if (r_val > FLT_MAX + || i_val > FLT_MAX + || r_val < FLT_MIN + || i_val < FLT_MIN) + return true; } return false; @@ -7370,7 +7370,7 @@ else { SPARSE_REDUCTION_OP (SparseComplexMatrix, Complex, *=, - (cidx(j+1) - cidx(j) < nr ? 0.0 : 1.0), 1.0); + (cidx(j+1) - cidx(j) < nr ? 0.0 : 1.0), 1.0); } } @@ -7392,7 +7392,7 @@ tmp [j] += d * conj (d) SPARSE_BASE_REDUCTION_OP (SparseComplexMatrix, Complex, ROW_EXPR, - COL_EXPR, 0.0, 0.0); + COL_EXPR, 0.0, 0.0); #undef ROW_EXPR #undef COL_EXPR @@ -7433,9 +7433,9 @@ for (octave_idx_type j = 0; j < nc; j++) { octave_quit (); for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) { - os << a.ridx(i) + 1 << " " << j + 1 << " "; - octave_write_complex (os, a.data(i)); - os << "\n"; + os << a.ridx(i) + 1 << " " << j + 1 << " "; + octave_write_complex (os, a.data(i)); + os << "\n"; } } @@ -7662,8 +7662,8 @@ result = SparseComplexMatrix (m); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - result.data(i) = xmin(c, m.data(i)); + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + result.data(i) = xmin(c, m.data(i)); } return result; @@ -7689,75 +7689,75 @@ octave_idx_type b_nc = b.cols (); if (a_nr == 0 || b_nc == 0 || a.nnz () == 0 || b.nnz () == 0) - return SparseComplexMatrix (a_nr, a_nc); + 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); + gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else - { - r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); + { + r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); - octave_idx_type jx = 0; - r.cidx (0) = 0; - for (octave_idx_type i = 0 ; i < a_nc ; i++) - { - octave_idx_type ja = a.cidx(i); - octave_idx_type ja_max = a.cidx(i+1); - bool ja_lt_max= ja < ja_max; + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; - octave_idx_type jb = b.cidx(i); - octave_idx_type jb_max = b.cidx(i+1); - bool jb_lt_max = jb < jb_max; + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; - while (ja_lt_max || jb_lt_max ) - { - octave_quit (); - if ((! jb_lt_max) || + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) - { - Complex tmp = xmin (a.data(ja), 0.); - if (tmp != 0.) - { - r.ridx(jx) = a.ridx(ja); - r.data(jx) = tmp; - jx++; - } - ja++; - ja_lt_max= ja < ja_max; - } - else if (( !ja_lt_max ) || - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) - { - Complex tmp = xmin (0., b.data(jb)); - if (tmp != 0.) - { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = tmp; - jx++; - } - jb++; - jb_lt_max= jb < jb_max; - } - else - { - Complex tmp = xmin (a.data(ja), b.data(jb)); - if (tmp != 0.) - { + { + Complex tmp = xmin (a.data(ja), 0.); + if (tmp != 0.) + { + r.ridx(jx) = a.ridx(ja); + r.data(jx) = tmp; + jx++; + } + ja++; + ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + Complex tmp = xmin (0., b.data(jb)); + if (tmp != 0.) + { + r.ridx(jx) = b.ridx(jb); + r.data(jx) = tmp; + jx++; + } + jb++; + jb_lt_max= jb < jb_max; + } + else + { + Complex tmp = xmin (a.data(ja), b.data(jb)); + if (tmp != 0.) + { r.data(jx) = tmp; r.ridx(jx) = a.ridx(ja); jx++; - } - ja++; - ja_lt_max= ja < ja_max; - jb++; - jb_lt_max= jb < jb_max; - } - } - r.cidx(i+1) = jx; - } - - r.maybe_compress (); - } + } + ja++; + ja_lt_max= ja < ja_max; + jb++; + jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } } else (*current_liboctave_error_handler) ("matrix size mismatch"); @@ -7780,8 +7780,8 @@ { result = SparseComplexMatrix (nr, nc, c); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - result.xdata(m.ridx(i) + j * nr) = xmax (c, m.data(i)); + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + result.xdata(m.ridx(i) + j * nr) = xmax (c, m.data(i)); } else result = SparseComplexMatrix (m); @@ -7809,79 +7809,79 @@ octave_idx_type b_nc = b.cols (); if (a_nr == 0 || b_nc == 0) - return SparseComplexMatrix (a_nr, a_nc); + return SparseComplexMatrix (a_nr, a_nc); if (a.nnz () == 0) - return SparseComplexMatrix (b); + return SparseComplexMatrix (b); if (b.nnz () == 0) - return SparseComplexMatrix (a); + return SparseComplexMatrix (a); if (a_nr != b_nr || a_nc != b_nc) - gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); + gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); else - { - r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); + { + r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); - octave_idx_type jx = 0; - r.cidx (0) = 0; - for (octave_idx_type i = 0 ; i < a_nc ; i++) - { - octave_idx_type ja = a.cidx(i); - octave_idx_type ja_max = a.cidx(i+1); - bool ja_lt_max= ja < ja_max; + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; - octave_idx_type jb = b.cidx(i); - octave_idx_type jb_max = b.cidx(i+1); - bool jb_lt_max = jb < jb_max; + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; - while (ja_lt_max || jb_lt_max ) - { - octave_quit (); - if ((! jb_lt_max) || + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) - { - Complex tmp = xmax (a.data(ja), 0.); - if (tmp != 0.) - { - r.ridx(jx) = a.ridx(ja); - r.data(jx) = tmp; - jx++; - } - ja++; - ja_lt_max= ja < ja_max; - } - else if (( !ja_lt_max ) || - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) - { - Complex tmp = xmax (0., b.data(jb)); - if (tmp != 0.) - { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = tmp; - jx++; - } - jb++; - jb_lt_max= jb < jb_max; - } - else - { - Complex tmp = xmax (a.data(ja), b.data(jb)); - if (tmp != 0.) - { + { + Complex tmp = xmax (a.data(ja), 0.); + if (tmp != 0.) + { + r.ridx(jx) = a.ridx(ja); + r.data(jx) = tmp; + jx++; + } + ja++; + ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + Complex tmp = xmax (0., b.data(jb)); + if (tmp != 0.) + { + r.ridx(jx) = b.ridx(jb); + r.data(jx) = tmp; + jx++; + } + jb++; + jb_lt_max= jb < jb_max; + } + else + { + Complex tmp = xmax (a.data(ja), b.data(jb)); + if (tmp != 0.) + { r.data(jx) = tmp; r.ridx(jx) = a.ridx(ja); jx++; - } - ja++; - ja_lt_max= ja < ja_max; - jb++; - jb_lt_max= jb < jb_max; - } - } - r.cidx(i+1) = jx; - } - - r.maybe_compress (); - } + } + ja++; + ja_lt_max= ja < ja_max; + jb++; + jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } } else (*current_liboctave_error_handler) ("matrix size mismatch"); @@ -7890,13 +7890,13 @@ } SPARSE_SMS_CMP_OPS (SparseComplexMatrix, 0.0, real, Complex, - 0.0, real) + 0.0, real) SPARSE_SMS_BOOL_OPS (SparseComplexMatrix, Complex, 0.0) SPARSE_SSM_CMP_OPS (Complex, 0.0, real, SparseComplexMatrix, - 0.0, real) + 0.0, real) SPARSE_SSM_BOOL_OPS (Complex, SparseComplexMatrix, 0.0) SPARSE_SMSM_CMP_OPS (SparseComplexMatrix, 0.0, real, SparseComplexMatrix, - 0.0, real) + 0.0, real) SPARSE_SMSM_BOOL_OPS (SparseComplexMatrix, SparseComplexMatrix, 0.0)
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,36 @@ +2010-02-11 John W. Eaton <jwe@octave.org> + + * Array-C.cc, Array-fC.cc, Array-util.cc, Array.cc, + CColVector.cc, CDiagMatrix.cc, CMatrix.cc, CNDArray.cc, + CRowVector.cc, CSparse.cc, CmplxAEPBAL.cc, CmplxCHOL.cc, + CmplxGEPBAL.cc, CmplxHESS.cc, CmplxLU.cc, CmplxQR.cc, + CmplxQRP.cc, CmplxSCHUR.cc, CmplxSVD.cc, CollocWt.cc, DASPK.cc, + DASRT.cc, DASSL.cc, EIG.cc, LSODE.cc, MSparse.cc, MatrixType.cc, + ODES.cc, Quad.cc, Range.cc, Sparse-C.cc, Sparse.cc, + SparseCmplxCHOL.cc, SparseCmplxLU.cc, SparseCmplxQR.cc, + SparseQR.cc, SparsedbleCHOL.cc, SparsedbleLU.cc, boolNDArray.cc, + boolSparse.cc, chMatrix.cc, chNDArray.cc, cmd-edit.cc, + cmd-hist.cc, dColVector.cc, dDiagMatrix.cc, dMatrix.cc, + dNDArray.cc, dRowVector.cc, dSparse.cc, data-conv.cc, + dbleAEPBAL.cc, dbleCHOL.cc, dbleGEPBAL.cc, dbleHESS.cc, + dbleLU.cc, dbleQR.cc, dbleQRP.cc, dbleSCHUR.cc, dbleSVD.cc, + dir-ops.cc, eigs-base.cc, fCColVector.cc, fCDiagMatrix.cc, + fCMatrix.cc, fCNDArray.cc, fCRowVector.cc, fCmplxAEPBAL.cc, + fCmplxCHOL.cc, fCmplxGEPBAL.cc, fCmplxHESS.cc, fCmplxLU.cc, + fCmplxQR.cc, fCmplxQRP.cc, fCmplxSCHUR.cc, fCmplxSVD.cc, + fColVector.cc, fDiagMatrix.cc, fEIG.cc, fMatrix.cc, fNDArray.cc, + fRowVector.cc, file-stat.cc, floatAEPBAL.cc, floatCHOL.cc, + floatGEPBAL.cc, floatHESS.cc, floatLU.cc, floatQR.cc, + floatQRP.cc, floatSCHUR.cc, floatSVD.cc, idx-vector.cc, + intNDArray.cc, kpse.cc, lo-ieee.cc, lo-mappers.cc, + lo-specfun.cc, lo-sysdep.cc, lo-utils.cc, mach-info.cc, + mx-inlines.cc, oct-alloc.cc, oct-env.cc, oct-fftw.cc, + oct-glob.cc, oct-group.cc, oct-inttypes.cc, oct-md5.cc, + oct-rand.cc, oct-shlib.cc, oct-sort.cc, oct-spparms.cc, + oct-syscalls.cc, oct-time.cc, pathsearch.cc, regex-match.cc, + sparse-base-chol.cc, sparse-base-lu.cc, sparse-dmsolve.cc, + sparse-sort.cc, sparse-util.cc, str-vec.cc: Untabify. + 2010-02-11 John W. Eaton <jwe@octave.org> * Array-util.h, Array.h, Array2.h, Array3.h, CColVector.h,
--- a/liboctave/CmplxAEPBAL.cc +++ b/liboctave/CmplxAEPBAL.cc @@ -36,17 +36,17 @@ { F77_RET_T F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, - octave_idx_type&, octave_idx_type&, double*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, + octave_idx_type&, octave_idx_type&, double*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, const double*, - const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, + const octave_idx_type&, const double*, + const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); } ComplexAEPBALANCE::ComplexAEPBALANCE (const ComplexMatrix& a, @@ -72,9 +72,9 @@ job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B'); F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, p_balanced_mat, n, ilo, ihi, - pscale, info - F77_CHAR_ARG_LEN (1))); + n, p_balanced_mat, n, ilo, ihi, + pscale, info + F77_CHAR_ARG_LEN (1))); } ComplexMatrix @@ -93,11 +93,11 @@ char side = 'R'; F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, - p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, + p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); return balancing_mat; }
--- a/liboctave/CmplxCHOL.cc +++ b/liboctave/CmplxCHOL.cc @@ -43,18 +43,18 @@ { F77_RET_T F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpotri, ZPOTRI) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpocon, ZPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - Complex*, const octave_idx_type&, const double&, - double&, Complex*, double*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + Complex*, const octave_idx_type&, const double&, + double&, Complex*, double*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); #ifdef HAVE_QRUPDATE F77_RET_T @@ -90,7 +90,7 @@ if (a_nr != a_nc) { (*current_liboctave_error_handler) - ("ComplexCHOL requires square matrix"); + ("ComplexCHOL requires square matrix"); return -1; } @@ -113,7 +113,7 @@ anorm = xnorm (a, 1); F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info - F77_CHAR_ARG_LEN (1))); + F77_CHAR_ARG_LEN (1))); xrcond = 0.0; if (info > 0) @@ -128,11 +128,11 @@ Array<double> rz (n); double *prz = rz.fortran_vec (); F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, prz, zpocon_info - F77_CHAR_ARG_LEN (1))); + n, anorm, xrcond, pz, prz, zpocon_info + F77_CHAR_ARG_LEN (1))); if (zpocon_info != 0) - info = -1; + info = -1; } return info; @@ -154,16 +154,16 @@ ComplexMatrix tmp = r; F77_XFCN (zpotri, ZPOTRI, (F77_CONST_CHAR_ARG2 ("U", 1), n, - tmp.fortran_vec (), n, info - F77_CHAR_ARG_LEN (1))); + tmp.fortran_vec (), n, info + F77_CHAR_ARG_LEN (1))); // If someone thinks of a more graceful way of doing this (or // faster for that matter :-)), please let me know! if (n > 1) - for (octave_idx_type j = 0; j < r_nc; j++) - for (octave_idx_type i = j+1; i < r_nr; i++) - tmp.xelem (i, j) = std::conj (tmp.xelem (j, i)); + for (octave_idx_type j = 0; j < r_nc; j++) + for (octave_idx_type i = j+1; i < r_nr; i++) + tmp.xelem (i, j) = std::conj (tmp.xelem (j, i)); retval = tmp; }
--- a/liboctave/CmplxGEPBAL.cc +++ b/liboctave/CmplxGEPBAL.cc @@ -37,27 +37,27 @@ { F77_RET_T F77_FUNC (zggbal, ZGGBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type& N, - Complex* A, const octave_idx_type& LDA, Complex* B, - const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, - double* LSCALE, double* RSCALE, - double* WORK, octave_idx_type& INFO - F77_CHAR_ARG_LEN_DECL); + Complex* A, const octave_idx_type& LDA, Complex* B, + const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, + double* LSCALE, double* RSCALE, + double* WORK, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dggbak, DGGBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type& N, const octave_idx_type& ILO, - const octave_idx_type& IHI, const double* LSCALE, - const double* RSCALE, octave_idx_type& M, double* V, - const octave_idx_type& LDV, octave_idx_type& INFO - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type& N, const octave_idx_type& ILO, + const octave_idx_type& IHI, const double* LSCALE, + const double* RSCALE, octave_idx_type& M, double* V, + const octave_idx_type& LDV, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type ComplexGEPBALANCE::init (const ComplexMatrix& a, const ComplexMatrix& b, - const std::string& balance_job) + const std::string& balance_job) { octave_idx_type n = a.cols (); @@ -89,9 +89,9 @@ char job = balance_job[0]; F77_XFCN (zggbal, ZGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, p_balanced_mat, n, p_balanced_mat2, - n, ilo, ihi, plscale, prscale, pwork, info - F77_CHAR_ARG_LEN (1))); + n, p_balanced_mat, n, p_balanced_mat2, + n, ilo, ihi, plscale, prscale, pwork, info + F77_CHAR_ARG_LEN (1))); balancing_mat = Matrix (n, n, 0.0); balancing_mat2 = Matrix (n, n, 0.0); @@ -107,19 +107,19 @@ // first left F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("L", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("L", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); // then right F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("R", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat2, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("R", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat2, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); return info; }
--- a/liboctave/CmplxHESS.cc +++ b/liboctave/CmplxHESS.cc @@ -33,27 +33,27 @@ { F77_RET_T F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, const octave_idx_type&, - octave_idx_type&, octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, Complex*, const octave_idx_type&, + octave_idx_type&, octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgehrd, ZGEHRD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, - Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, const octave_idx_type&, Complex*, + Complex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zunghr, ZUNGHR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, - Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, const octave_idx_type&, Complex*, + Complex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, + const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type @@ -65,7 +65,7 @@ if (a_nr != a_nc) { (*current_liboctave_error_handler) - ("ComplexHESS requires square matrix"); + ("ComplexHESS requires square matrix"); return -1; } @@ -85,8 +85,8 @@ double *pscale = scale.fortran_vec (); F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, h, n, ilo, ihi, pscale, info - F77_CHAR_ARG_LEN (1))); + n, h, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); Array<Complex> tau (n-1); Complex *ptau = tau.fortran_vec (); @@ -100,13 +100,13 @@ Complex *z = unitary_hess_mat.fortran_vec (); F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + lwork, info)); F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, z, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, z, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); // If someone thinks of a more graceful way of // doing this (or faster for that matter :-)), @@ -115,7 +115,7 @@ if (n > 2) for (octave_idx_type j = 0; j < a_nc; j++) for (octave_idx_type i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; + hess_mat.elem (i, j) = 0; return info; }
--- a/liboctave/CmplxLU.cc +++ b/liboctave/CmplxLU.cc @@ -45,7 +45,7 @@ { F77_RET_T F77_FUNC (zgetrf, ZGETRF) (const octave_idx_type&, const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type*, octave_idx_type&); + const octave_idx_type&, octave_idx_type*, octave_idx_type&); #ifdef HAVE_QRUPDATE_LUU F77_RET_T
--- a/liboctave/CmplxQR.cc +++ b/liboctave/CmplxQR.cc @@ -42,13 +42,13 @@ { F77_RET_T F77_FUNC (zgeqrf, ZGEQRF) (const octave_idx_type&, const octave_idx_type&, Complex*, - const octave_idx_type&, Complex*, Complex*, - const octave_idx_type&, octave_idx_type&); + const octave_idx_type&, Complex*, Complex*, + const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zungqr, ZUNGQR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, - Complex*, const octave_idx_type&, octave_idx_type&); + Complex*, const octave_idx_type&, Complex*, + Complex*, const octave_idx_type&, octave_idx_type&); #ifdef HAVE_QRUPDATE @@ -131,11 +131,11 @@ if (qr_type == qr_type_raw) { for (octave_idx_type j = 0; j < min_mn; j++) - { - octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; - for (octave_idx_type i = limit + 1; i < m; i++) - afact.elem (i, j) *= tau[j]; - } + { + octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; + for (octave_idx_type i = limit + 1; i < m; i++) + afact.elem (i, j) *= tau[j]; + } r = afact; } @@ -182,7 +182,7 @@ // allocate buffer and do the job. octave_idx_type lwork = clwork.real (); - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (Complex, work, lwork); F77_XFCN (zungqr, ZUNGQR, (m, k, min_mn, q.fortran_vec (), m, tau, work, lwork, info)); @@ -300,7 +300,7 @@ OCTAVE_LOCAL_BUFFER (double, rw, kmax); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; ComplexColumnVector utmp = u.column (jsi(i)); F77_XFCN (zqrinc, ZQRINC, (m, n + ii, std::min (kmax, k + ii), q.fortran_vec (), q.rows (), @@ -323,7 +323,7 @@ { OCTAVE_LOCAL_BUFFER (double, rw, k); F77_XFCN (zqrdec, ZQRDEC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, rw)); + r.fortran_vec (), r.rows (), j + 1, rw)); if (k < m) { @@ -360,7 +360,7 @@ OCTAVE_LOCAL_BUFFER (double, rw, k); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; F77_XFCN (zqrdec, ZQRDEC, (m, n - ii, k == m ? k : k - ii, q.fortran_vec (), q.rows (), r.fortran_vec (), r.rows (), js(ii) + 1, rw)); @@ -396,7 +396,7 @@ ComplexRowVector utmp = u; OCTAVE_LOCAL_BUFFER (double, rw, k); F77_XFCN (zqrinr, ZQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), + r.fortran_vec (), r.rows (), j + 1, utmp.fortran_vec (), rw)); } @@ -417,7 +417,7 @@ OCTAVE_LOCAL_BUFFER (Complex, w, m); OCTAVE_LOCAL_BUFFER (double, rw, m); F77_XFCN (zqrder, ZQRDER, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, + r.fortran_vec (), r.rows (), j + 1, w, rw)); q.resize (m - 1, m - 1);
--- a/liboctave/CmplxQRP.cc +++ b/liboctave/CmplxQRP.cc @@ -36,8 +36,8 @@ { F77_RET_T F77_FUNC (zgeqp3, ZGEQP3) (const octave_idx_type&, const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type*, Complex*, Complex*, - const octave_idx_type&, double*, octave_idx_type&); + const octave_idx_type&, octave_idx_type*, Complex*, Complex*, + const octave_idx_type&, double*, octave_idx_type&); } // It would be best to share some of this code with ComplexQR class...
--- a/liboctave/CmplxSCHUR.cc +++ b/liboctave/CmplxSCHUR.cc @@ -33,16 +33,16 @@ { F77_RET_T F77_FUNC (zgeesx, ZGEESX) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - ComplexSCHUR::select_function, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type&, - Complex*, Complex*, const octave_idx_type&, double&, - double&, Complex*, const octave_idx_type&, double*, octave_idx_type*, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + ComplexSCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type&, + Complex*, Complex*, const octave_idx_type&, double&, + double&, Complex*, const octave_idx_type&, double*, octave_idx_type*, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } static octave_idx_type @@ -59,7 +59,7 @@ octave_idx_type ComplexSCHUR::init (const ComplexMatrix& a, const std::string& ord, - bool calc_unitary) + bool calc_unitary) { octave_idx_type a_nr = a.rows (); octave_idx_type a_nc = a.cols (); @@ -67,7 +67,7 @@ if (a_nr != a_nc) { (*current_liboctave_error_handler) - ("ComplexSCHUR requires square matrix"); + ("ComplexSCHUR requires square matrix"); return -1; } @@ -123,14 +123,14 @@ octave_idx_type *pbwork = bwork.fortran_vec (); F77_XFCN (zgeesx, ZGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, s, n, sdim, pw, q, n, rconde, rcondv, - pwork, lwork, prwork, pbwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, s, n, sdim, pw, q, n, rconde, rcondv, + pwork, lwork, prwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); return info; }
--- a/liboctave/CmplxSVD.cc +++ b/liboctave/CmplxSVD.cc @@ -33,13 +33,13 @@ { F77_RET_T F77_FUNC (zgesvd, ZGESVD) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, Complex*, - const octave_idx_type&, double*, Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, - double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, Complex*, + const octave_idx_type&, double*, Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, + double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } ComplexMatrix @@ -48,7 +48,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("ComplexSVD: U not computed because type == SVD::sigma_only"); + ("ComplexSVD: U not computed because type == SVD::sigma_only"); return ComplexMatrix (); } else @@ -61,7 +61,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("ComplexSVD: V not computed because type == SVD::sigma_only"); + ("ComplexSVD: V not computed because type == SVD::sigma_only"); return ComplexMatrix (); } else @@ -145,23 +145,23 @@ octave_idx_type m1 = std::max (m, one), nrow_vt1 = std::max (nrow_vt, one); F77_XFCN (zgesvd, ZGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), - F77_CONST_CHAR_ARG2 (&jobv, 1), - m, n, tmp_data, m1, s_vec, u, m1, vt, - nrow_vt1, work.fortran_vec (), lwork, - rwork.fortran_vec (), info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m1, s_vec, u, m1, vt, + nrow_vt1, work.fortran_vec (), lwork, + rwork.fortran_vec (), info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); lwork = static_cast<octave_idx_type> (work(0).real ()); work.resize (lwork); F77_XFCN (zgesvd, ZGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), - F77_CONST_CHAR_ARG2 (&jobv, 1), - m, n, tmp_data, m1, s_vec, u, m1, vt, - nrow_vt1, work.fortran_vec (), lwork, - rwork.fortran_vec (), info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m1, s_vec, u, m1, vt, + nrow_vt1, work.fortran_vec (), lwork, + rwork.fortran_vec (), info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (! (jobv == 'N' || jobv == 'O')) right_sm = right_sm.hermitian ();
--- a/liboctave/CollocWt.cc +++ b/liboctave/CollocWt.cc @@ -35,13 +35,13 @@ { F77_RET_T F77_FUNC (jcobi, JCOBI) (octave_idx_type&, octave_idx_type&, octave_idx_type&, octave_idx_type&, double&, - double&, double*, double*, double*, - double*); + double&, double*, double*, double*, + double*); F77_RET_T F77_FUNC (dfopr, DFOPR) (octave_idx_type&, octave_idx_type&, octave_idx_type&, octave_idx_type&, octave_idx_type&, octave_idx_type&, - double*, double*, double*, double*, - double*); + double*, double*, double*, double*, + double*); } // Error handling. @@ -124,7 +124,7 @@ // Compute roots. F77_FUNC (jcobi, JCOBI) (nt, n, inc_left, inc_right, Alpha, Beta, - pdif1, pdif2, pdif3, pr); + pdif1, pdif2, pdif3, pr); octave_idx_type id; @@ -134,10 +134,10 @@ for (octave_idx_type i = 1; i <= nt; i++) { F77_FUNC (dfopr, DFOPR) (nt, n, inc_left, inc_right, i, id, pdif1, - pdif2, pdif3, pr, pvect); + pdif2, pdif3, pr, pvect); for (octave_idx_type j = 0; j < nt; j++) - A (i-1, j) = vect.elem (j); + A (i-1, j) = vect.elem (j); } // Second derivative weights. @@ -146,10 +146,10 @@ for (octave_idx_type i = 1; i <= nt; i++) { F77_FUNC (dfopr, DFOPR) (nt, n, inc_left, inc_right, i, id, pdif1, - pdif2, pdif3, pr, pvect); + pdif2, pdif3, pr, pvect); for (octave_idx_type j = 0; j < nt; j++) - B (i-1, j) = vect.elem (j); + B (i-1, j) = vect.elem (j); } // Gaussian quadrature weights. @@ -157,7 +157,7 @@ id = 3; double *pq = q.fortran_vec (); F77_FUNC (dfopr, DFOPR) (nt, n, inc_left, inc_right, id, id, pdif1, - pdif2, pdif3, pr, pq); + pdif2, pdif3, pr, pq); initialized = 1; }
--- a/liboctave/DASPK.cc +++ b/liboctave/DASPK.cc @@ -36,29 +36,29 @@ #include "quit.h" typedef octave_idx_type (*daspk_fcn_ptr) (const double&, const double*, - const double*, const double&, - double*, octave_idx_type&, double*, octave_idx_type*); + const double*, const double&, + double*, octave_idx_type&, double*, octave_idx_type*); typedef octave_idx_type (*daspk_jac_ptr) (const double&, const double*, - const double*, double*, - const double&, double*, octave_idx_type*); + const double*, double*, + const double&, double*, octave_idx_type*); typedef octave_idx_type (*daspk_psol_ptr) (const octave_idx_type&, const double&, - const double*, const double*, - const double*, const double&, - const double*, double*, octave_idx_type*, - double*, const double&, octave_idx_type&, - double*, octave_idx_type*); + const double*, const double*, + const double*, const double&, + const double*, double*, octave_idx_type*, + double*, const double&, octave_idx_type&, + double*, octave_idx_type*); extern "C" { F77_RET_T F77_FUNC (ddaspk, DDASPK) (daspk_fcn_ptr, const octave_idx_type&, double&, - double*, double*, double&, const octave_idx_type*, - const double*, const double*, octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type*, const octave_idx_type&, - const double*, const octave_idx_type*, - daspk_jac_ptr, daspk_psol_ptr); + double*, double*, double&, const octave_idx_type*, + const double*, const double*, octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type*, const octave_idx_type&, + const double*, const octave_idx_type*, + daspk_jac_ptr, daspk_psol_ptr); } static DAEFunc::DAERHSFunc user_fun; @@ -67,7 +67,7 @@ static octave_idx_type ddaspk_f (const double& time, const double *state, const double *deriv, - const double&, double *delta, octave_idx_type& ires, double *, octave_idx_type *) + const double&, double *delta, octave_idx_type& ires, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -86,12 +86,12 @@ if (ires >= 0) { if (tmp_delta.length () == 0) - ires = -2; + ires = -2; else - { - for (octave_idx_type i = 0; i < nn; i++) - delta [i] = tmp_delta.elem (i); - } + { + for (octave_idx_type i = 0; i < nn; i++) + delta [i] = tmp_delta.elem (i); + } } END_INTERRUPT_WITH_EXCEPTIONS; @@ -104,9 +104,9 @@ static octave_idx_type ddaspk_psol (const octave_idx_type&, const double&, const double *, - const double *, const double *, const double&, - const double *, double *, octave_idx_type *, double *, - const double&, octave_idx_type&, double *, octave_idx_type*) + const double *, const double *, const double&, + const double *, double *, octave_idx_type *, double *, + const double&, octave_idx_type&, double *, octave_idx_type*) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -120,7 +120,7 @@ static octave_idx_type ddaspk_j (const double& time, const double *state, const double *deriv, - double *pd, const double& cj, double *, octave_idx_type *) + double *pd, const double& cj, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -163,7 +163,7 @@ info.resize (20); for (octave_idx_type i = 0; i < 20; i++) - info(i) = 0; + info(i) = 0; pinfo = info.fortran_vec (); @@ -174,12 +174,12 @@ info(0) = 0; if (stop_time_set) - { - rwork(0) = stop_time; - info(3) = 1; - } + { + rwork(0) = stop_time; + info(3) = 1; + } else - info(3) = 0; + info(3) = 0; px = x.fortran_vec (); pxdot = xdot.fortran_vec (); @@ -190,28 +190,28 @@ user_jac = DAEFunc::jacobian_function (); if (user_fun) - { - octave_idx_type ires = 0; + { + octave_idx_type ires = 0; - ColumnVector res = (*user_fun) (x, xdot, t, ires); + ColumnVector res = (*user_fun) (x, xdot, t, ires); - if (res.length () != x.length ()) - { - (*current_liboctave_error_handler) - ("daspk: inconsistent sizes for state and residual vectors"); + if (res.length () != x.length ()) + { + (*current_liboctave_error_handler) + ("daspk: inconsistent sizes for state and residual vectors"); - integration_error = true; - return retval; - } - } + integration_error = true; + return retval; + } + } else - { - (*current_liboctave_error_handler) - ("daspk: no user supplied RHS subroutine!"); + { + (*current_liboctave_error_handler) + ("daspk: no user supplied RHS subroutine!"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } info(4) = user_jac ? 1 : 0; @@ -223,13 +223,13 @@ liw = 40 + n; if (eiq == 1 || eiq == 3) - liw += n; + liw += n; if (ccic == 1 || eavfet == 1) - liw += n; + liw += n; lrw = 50 + 9*n + n*n; if (eavfet == 1) - lrw += n; + lrw += n; iwork.resize (liw); rwork.resize (lrw); @@ -246,208 +246,208 @@ octave_idx_type rel_tol_len = rel_tol.length (); if (abs_tol_len == 1 && rel_tol_len == 1) - { - info(1) = 0; - } + { + info(1) = 0; + } else if (abs_tol_len == n && rel_tol_len == n) - { - info(1) = 1; - } + { + info(1) = 1; + } else - { - (*current_liboctave_error_handler) - ("daspk: inconsistent sizes for tolerance arrays"); + { + (*current_liboctave_error_handler) + ("daspk: inconsistent sizes for tolerance arrays"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } pabs_tol = abs_tol.fortran_vec (); prel_tol = rel_tol.fortran_vec (); double hmax = maximum_step_size (); if (hmax >= 0.0) - { - rwork(1) = hmax; - info(6) = 1; - } + { + rwork(1) = hmax; + info(6) = 1; + } else - info(6) = 0; + info(6) = 0; double h0 = initial_step_size (); if (h0 >= 0.0) - { - rwork(2) = h0; - info(7) = 1; - } + { + rwork(2) = h0; + info(7) = 1; + } else - info(7) = 0; + info(7) = 0; octave_idx_type maxord = maximum_order (); if (maxord >= 0) - { - if (maxord > 0 && maxord < 6) - { - info(8) = 1; - iwork(2) = maxord; - } - else - { - (*current_liboctave_error_handler) - ("daspk: invalid value for maximum order"); - integration_error = true; - return retval; - } - } + { + if (maxord > 0 && maxord < 6) + { + info(8) = 1; + iwork(2) = maxord; + } + else + { + (*current_liboctave_error_handler) + ("daspk: invalid value for maximum order"); + integration_error = true; + return retval; + } + } switch (eiq) - { - case 1: - case 3: - { - Array<octave_idx_type> ict = inequality_constraint_types (); + { + case 1: + case 3: + { + Array<octave_idx_type> ict = inequality_constraint_types (); - if (ict.length () == n) - { - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type val = ict(i); - if (val < -2 || val > 2) - { - (*current_liboctave_error_handler) - ("daspk: invalid value for inequality constraint type"); - integration_error = true; - return retval; - } - iwork(40+i) = val; - } - } - else - { - (*current_liboctave_error_handler) - ("daspk: inequality constraint types size mismatch"); - integration_error = true; - return retval; - } - } - // Fall through... + if (ict.length () == n) + { + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type val = ict(i); + if (val < -2 || val > 2) + { + (*current_liboctave_error_handler) + ("daspk: invalid value for inequality constraint type"); + integration_error = true; + return retval; + } + iwork(40+i) = val; + } + } + else + { + (*current_liboctave_error_handler) + ("daspk: inequality constraint types size mismatch"); + integration_error = true; + return retval; + } + } + // Fall through... - case 0: - case 2: - info(9) = eiq; - break; + case 0: + case 2: + info(9) = eiq; + break; - default: - (*current_liboctave_error_handler) - ("daspk: invalid value for enforce inequality constraints option"); - integration_error = true; - return retval; - } + default: + (*current_liboctave_error_handler) + ("daspk: invalid value for enforce inequality constraints option"); + integration_error = true; + return retval; + } if (ccic) - { - if (ccic == 1) - { - // FIXME -- this code is duplicated below. + { + if (ccic == 1) + { + // FIXME -- this code is duplicated below. - Array<octave_idx_type> av = algebraic_variables (); + Array<octave_idx_type> av = algebraic_variables (); - if (av.length () == n) - { - octave_idx_type lid; - if (eiq == 0 || eiq == 2) - lid = 40; - else if (eiq == 1 || eiq == 3) - lid = 40 + n; - else - abort (); + if (av.length () == n) + { + octave_idx_type lid; + if (eiq == 0 || eiq == 2) + lid = 40; + else if (eiq == 1 || eiq == 3) + lid = 40 + n; + else + abort (); - for (octave_idx_type i = 0; i < n; i++) - iwork(lid+i) = av(i) ? -1 : 1; - } - else - { - (*current_liboctave_error_handler) - ("daspk: algebraic variables size mismatch"); - integration_error = true; - return retval; - } - } - else if (ccic != 2) - { - (*current_liboctave_error_handler) - ("daspk: invalid value for compute consistent initial condition option"); - integration_error = true; - return retval; - } + for (octave_idx_type i = 0; i < n; i++) + iwork(lid+i) = av(i) ? -1 : 1; + } + else + { + (*current_liboctave_error_handler) + ("daspk: algebraic variables size mismatch"); + integration_error = true; + return retval; + } + } + else if (ccic != 2) + { + (*current_liboctave_error_handler) + ("daspk: invalid value for compute consistent initial condition option"); + integration_error = true; + return retval; + } - info(10) = ccic; - } + info(10) = ccic; + } if (eavfet) - { - info(15) = 1; + { + info(15) = 1; - // FIXME -- this code is duplicated above. + // FIXME -- this code is duplicated above. - Array<octave_idx_type> av = algebraic_variables (); + Array<octave_idx_type> av = algebraic_variables (); - if (av.length () == n) - { - octave_idx_type lid; - if (eiq == 0 || eiq == 2) - lid = 40; - else if (eiq == 1 || eiq == 3) - lid = 40 + n; - else - abort (); + if (av.length () == n) + { + octave_idx_type lid; + if (eiq == 0 || eiq == 2) + lid = 40; + else if (eiq == 1 || eiq == 3) + lid = 40 + n; + else + abort (); - for (octave_idx_type i = 0; i < n; i++) - iwork(lid+i) = av(i) ? -1 : 1; - } - } + for (octave_idx_type i = 0; i < n; i++) + iwork(lid+i) = av(i) ? -1 : 1; + } + } if (use_initial_condition_heuristics ()) - { - Array<double> ich = initial_condition_heuristics (); + { + Array<double> ich = initial_condition_heuristics (); - if (ich.length () == 6) - { - iwork(31) = NINTbig (ich(0)); - iwork(32) = NINTbig (ich(1)); - iwork(33) = NINTbig (ich(2)); - iwork(34) = NINTbig (ich(3)); + if (ich.length () == 6) + { + iwork(31) = NINTbig (ich(0)); + iwork(32) = NINTbig (ich(1)); + iwork(33) = NINTbig (ich(2)); + iwork(34) = NINTbig (ich(3)); - rwork(13) = ich(4); - rwork(14) = ich(5); - } - else - { - (*current_liboctave_error_handler) - ("daspk: invalid initial condition heuristics option"); - integration_error = true; - return retval; - } + rwork(13) = ich(4); + rwork(14) = ich(5); + } + else + { + (*current_liboctave_error_handler) + ("daspk: invalid initial condition heuristics option"); + integration_error = true; + return retval; + } - info(16) = 1; - } + info(16) = 1; + } octave_idx_type pici = print_initial_condition_info (); switch (pici) - { - case 0: - case 1: - case 2: - info(17) = pici; - break; + { + case 0: + case 1: + case 2: + info(17) = pici; + break; - default: - (*current_liboctave_error_handler) - ("daspk: invalid value for print initial condition info option"); - integration_error = true; - return retval; - break; - } + default: + (*current_liboctave_error_handler) + ("daspk: invalid value for print initial condition info option"); + integration_error = true; + return retval; + break; + } DASPK_options::reset = false; @@ -458,23 +458,23 @@ static octave_idx_type *idummy = 0; F77_XFCN (ddaspk, DDASPK, (ddaspk_f, nn, t, px, pxdot, tout, pinfo, - prel_tol, pabs_tol, istate, prwork, lrw, - piwork, liw, dummy, idummy, ddaspk_j, - ddaspk_psol)); + prel_tol, pabs_tol, istate, prwork, lrw, + piwork, liw, dummy, idummy, ddaspk_j, + ddaspk_psol)); switch (istate) { case 1: // A step was successfully taken in intermediate-output - // mode. The code has not yet reached TOUT. + // mode. The code has not yet reached TOUT. case 2: // The integration to TSTOP was successfully completed - // (T=TSTOP) by stepping exactly to TSTOP. + // (T=TSTOP) by stepping exactly to TSTOP. case 3: // The integration to TOUT was successfully completed - // (T=TOUT) by stepping past TOUT. Y(*) is obtained by - // interpolation. YPRIME(*) is obtained by interpolation. + // (T=TOUT) by stepping past TOUT. Y(*) is obtained by + // interpolation. YPRIME(*) is obtained by interpolation. case 4: // The initial condition calculation, with - // INFO(11) > 0, was successful, and INFO(14) = 1. - // No integration steps were taken, and the solution - // is not considered to have been started. + // INFO(11) > 0, was successful, and INFO(14) = 1. + // No integration steps were taken, and the solution + // is not considered to have been started. retval = x; t = tout; break; @@ -482,38 +482,38 @@ case -1: // A large amount of work has been expended. (~500 steps). case -2: // The error tolerances are too stringent. case -3: // The local error test cannot be satisfied because you - // specified a zero component in ATOL and the - // corresponding computed solution component is zero. - // Thus, a pure relative error test is impossible for - // this component. + // specified a zero component in ATOL and the + // corresponding computed solution component is zero. + // Thus, a pure relative error test is impossible for + // this component. case -6: // DDASPK had repeated error test failures on the last - // attempted step. + // attempted step. case -7: // The corrector could not converge. case -8: // The matrix of partial derivatives is singular. case -9: // The corrector could not converge. There were repeated - // error test failures in this step. + // error test failures in this step. case -10: // The corrector could not converge because IRES was - // equal to minus one. + // equal to minus one. case -11: // IRES equal to -2 was encountered and control is being - // returned to the calling program. + // returned to the calling program. case -12: // DDASPK failed to compute the initial YPRIME. case -13: // Unrecoverable error encountered inside user's - // PSOL routine, and control is being returned to - // the calling program. + // PSOL routine, and control is being returned to + // the calling program. case -14: // The Krylov linear system solver could not - // achieve convergence. + // achieve convergence. case -33: // The code has encountered trouble from which it cannot - // recover. A message is printed explaining the trouble - // and control is returned to the calling program. For - // example, this occurs when invalid input is detected. + // recover. A message is printed explaining the trouble + // and control is returned to the calling program. For + // example, this occurs when invalid input is detected. integration_error = true; break; default: integration_error = true; (*current_liboctave_error_handler) - ("unrecognized value of istate (= %d) returned from ddaspk", - istate); + ("unrecognized value of istate (= %d) returned from ddaspk", + istate); break; } @@ -541,24 +541,24 @@ xdot_out.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (0, i) = x.elem (i); - xdot_out.elem (0, i) = xdot.elem (i); - } + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } for (octave_idx_type j = 1; j < n_out; j++) - { - ColumnVector x_next = do_integrate (tout.elem (j)); + { + ColumnVector x_next = do_integrate (tout.elem (j)); - if (integration_error) - return retval; + if (integration_error) + return retval; - for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (j, i) = x_next.elem (i); - xdot_out.elem (j, i) = xdot.elem (i); - } - } + for (octave_idx_type i = 0; i < n; i++) + { + retval.elem (j, i) = x_next.elem (i); + xdot_out.elem (j, i) = xdot.elem (i); + } + } } return retval; @@ -573,7 +573,7 @@ Matrix DASPK::integrate (const ColumnVector& tout, Matrix& xdot_out, - const ColumnVector& tcrit) + const ColumnVector& tcrit) { Matrix retval; @@ -586,90 +586,90 @@ xdot_out.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (0, i) = x.elem (i); - xdot_out.elem (0, i) = xdot.elem (i); - } + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } octave_idx_type n_crit = tcrit.capacity (); if (n_crit > 0) - { - octave_idx_type i_crit = 0; - octave_idx_type i_out = 1; - double next_crit = tcrit.elem (0); - double next_out; - while (i_out < n_out) - { - bool do_restart = false; + { + octave_idx_type i_crit = 0; + octave_idx_type i_out = 1; + double next_crit = tcrit.elem (0); + double next_out; + while (i_out < n_out) + { + bool do_restart = false; - next_out = tout.elem (i_out); - if (i_crit < n_crit) - next_crit = tcrit.elem (i_crit); + next_out = tout.elem (i_out); + if (i_crit < n_crit) + next_crit = tcrit.elem (i_crit); - bool save_output; - double t_out; + bool save_output; + double t_out; - if (next_crit == next_out) - { - set_stop_time (next_crit); - t_out = next_out; - save_output = true; - i_out++; - i_crit++; - do_restart = true; - } - else if (next_crit < next_out) - { - if (i_crit < n_crit) - { - set_stop_time (next_crit); - t_out = next_crit; - save_output = false; - i_crit++; - do_restart = true; - } - else - { - clear_stop_time (); - t_out = next_out; - save_output = true; - i_out++; - } - } - else - { - set_stop_time (next_crit); - t_out = next_out; - save_output = true; - i_out++; - } + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = true; + i_out++; + i_crit++; + do_restart = true; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = false; + i_crit++; + do_restart = true; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = true; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = true; + i_out++; + } - ColumnVector x_next = do_integrate (t_out); + ColumnVector x_next = do_integrate (t_out); - if (integration_error) - return retval; + if (integration_error) + return retval; - if (save_output) - { - for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (i_out-1, i) = x_next.elem (i); - xdot_out.elem (i_out-1, i) = xdot.elem (i); - } - } + if (save_output) + { + for (octave_idx_type i = 0; i < n; i++) + { + retval.elem (i_out-1, i) = x_next.elem (i); + xdot_out.elem (i_out-1, i) = xdot.elem (i); + } + } - if (do_restart) - force_restart (); - } - } + if (do_restart) + force_restart (); + } + } else - { - retval = integrate (tout, xdot_out); + { + retval = integrate (tout, xdot_out); - if (integration_error) - return retval; - } + if (integration_error) + return retval; + } } return retval; @@ -704,7 +704,7 @@ case -1: retval = std::string ("a large amount of work has been expended (t =") - + t_curr + ")"; + + t_curr + ")"; break; case -2: @@ -713,38 +713,38 @@ case -3: retval = std::string ("error weight became zero during problem. (t = ") - + t_curr - + "; solution component i vanished, and atol or atol(i) == 0)"; + + t_curr + + "; solution component i vanished, and atol or atol(i) == 0)"; break; case -6: retval = std::string ("repeated error test failures on the last attempted step (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -7: retval = std::string ("the corrector could not converge (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -8: retval = std::string ("the matrix of partial derivatives is singular (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -9: retval = std::string ("the corrector could not converge (t = ") - + t_curr + "; repeated test failures)"; + + t_curr + "; repeated test failures)"; break; case -10: retval = std::string ("corrector could not converge because IRES was -1 (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -11: retval = std::string ("return requested in user-supplied function (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -12: @@ -753,12 +753,12 @@ case -13: retval = std::string ("unrecoverable error encountered inside user's PSOL function (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -14: retval = std::string ("the Krylov linear system solver failed to converge (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -33:
--- a/liboctave/DASRT.cc +++ b/liboctave/DASRT.cc @@ -35,23 +35,23 @@ #include "quit.h" typedef octave_idx_type (*dasrt_fcn_ptr) (const double&, const double*, const double*, - double*, octave_idx_type&, double*, octave_idx_type*); + double*, octave_idx_type&, double*, octave_idx_type*); typedef octave_idx_type (*dasrt_jac_ptr) (const double&, const double*, const double*, - double*, const double&, double*, octave_idx_type*); + double*, const double&, double*, octave_idx_type*); typedef octave_idx_type (*dasrt_constr_ptr) (const octave_idx_type&, const double&, const double*, - const octave_idx_type&, double*, double*, octave_idx_type*); + const octave_idx_type&, double*, double*, octave_idx_type*); extern "C" { F77_RET_T F77_FUNC (ddasrt, DDASRT) (dasrt_fcn_ptr, const octave_idx_type&, double&, - double*, double*, const double&, octave_idx_type*, - const double*, const double*, octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type*, const octave_idx_type&, double*, - octave_idx_type*, dasrt_jac_ptr, dasrt_constr_ptr, - const octave_idx_type&, octave_idx_type*); + double*, double*, const double&, octave_idx_type*, + const double*, const double*, octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type*, const octave_idx_type&, double*, + octave_idx_type*, dasrt_jac_ptr, dasrt_constr_ptr, + const octave_idx_type&, octave_idx_type*); } static DAEFunc::DAERHSFunc user_fsub; @@ -62,7 +62,7 @@ static octave_idx_type ddasrt_f (const double& t, const double *state, const double *deriv, - double *delta, octave_idx_type& ires, double *, octave_idx_type *) + double *delta, octave_idx_type& ires, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -82,7 +82,7 @@ else { for (octave_idx_type i = 0; i < nn; i++) - delta[i] = tmp_fval(i); + delta[i] = tmp_fval(i); } END_INTERRUPT_WITH_EXCEPTIONS; @@ -92,7 +92,7 @@ octave_idx_type ddasrt_j (const double& time, const double *state, const double *deriv, - double *pd, const double& cj, double *, octave_idx_type *) + double *pd, const double& cj, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -120,7 +120,7 @@ static octave_idx_type ddasrt_g (const octave_idx_type& neq, const double& t, const double *state, - const octave_idx_type& ng, double *gout, double *, octave_idx_type *) + const octave_idx_type& ng, double *gout, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -159,7 +159,7 @@ info.resize (15); for (octave_idx_type i = 0; i < 15; i++) - info(i) = 0; + info(i) = 0; pinfo = info.fortran_vec (); @@ -172,29 +172,29 @@ user_csub = DAERTFunc::constraint_function (); if (user_csub) - { - ColumnVector tmp = (*user_csub) (x, t); - ng = tmp.length (); - } + { + ColumnVector tmp = (*user_csub) (x, t); + ng = tmp.length (); + } else - ng = 0; + ng = 0; octave_idx_type maxord = maximum_order (); if (maxord >= 0) - { - if (maxord > 0 && maxord < 6) - { - info(8) = 1; - iwork(2) = maxord; - } - else - { - (*current_liboctave_error_handler) - ("dassl: invalid value for maximum order"); - integration_error = true; - return; - } - } + { + if (maxord > 0 && maxord < 6) + { + info(8) = 1; + iwork(2) = maxord; + } + else + { + (*current_liboctave_error_handler) + ("dassl: invalid value for maximum order"); + integration_error = true; + return; + } + } liw = 21 + n; lrw = 50 + 9*n + n*n + 3*ng; @@ -205,12 +205,12 @@ info(0) = 0; if (stop_time_set) - { - info(3) = 1; - rwork(0) = stop_time; - } + { + info(3) = 1; + rwork(0) = stop_time; + } else - info(3) = 0; + info(3) = 0; px = x.fortran_vec (); pxdot = xdot.fortran_vec (); @@ -226,28 +226,28 @@ user_jsub = DAEFunc::jacobian_function (); if (user_fsub) - { - octave_idx_type ires = 0; + { + octave_idx_type ires = 0; - ColumnVector fval = (*user_fsub) (x, xdot, t, ires); + ColumnVector fval = (*user_fsub) (x, xdot, t, ires); - if (fval.length () != x.length ()) - { - (*current_liboctave_error_handler) - ("dasrt: inconsistent sizes for state and residual vectors"); + if (fval.length () != x.length ()) + { + (*current_liboctave_error_handler) + ("dasrt: inconsistent sizes for state and residual vectors"); - integration_error = true; - return; - } - } + integration_error = true; + return; + } + } else - { - (*current_liboctave_error_handler) - ("dasrt: no user supplied RHS subroutine!"); + { + (*current_liboctave_error_handler) + ("dasrt: no user supplied RHS subroutine!"); - integration_error = true; - return; - } + integration_error = true; + return; + } info(4) = user_jsub ? 1 : 0; @@ -263,29 +263,29 @@ double mss = maximum_step_size (); if (mss >= 0.0) - { - rwork(1) = mss; - info(6) = 1; - } + { + rwork(1) = mss; + info(6) = 1; + } else - info(6) = 0; + info(6) = 0; double iss = initial_step_size (); if (iss >= 0.0) - { - rwork(2) = iss; - info(7) = 1; - } + { + rwork(2) = iss; + info(7) = 1; + } else - info(7) = 0; + info(7) = 0; if (step_limit () >= 0) - { - info(11) = 1; - iwork(20) = step_limit (); - } + { + info(11) = 1; + iwork(20) = step_limit (); + } else - info(11) = 0; + info(11) = 0; abs_tol = absolute_tolerance (); rel_tol = relative_tolerance (); @@ -294,21 +294,21 @@ octave_idx_type rel_tol_len = rel_tol.length (); if (abs_tol_len == 1 && rel_tol_len == 1) - { - info.elem (1) = 0; - } + { + info.elem (1) = 0; + } else if (abs_tol_len == n && rel_tol_len == n) - { - info.elem (1) = 1; - } + { + info.elem (1) = 1; + } else - { - (*current_liboctave_error_handler) - ("dasrt: inconsistent sizes for tolerance arrays"); + { + (*current_liboctave_error_handler) + ("dasrt: inconsistent sizes for tolerance arrays"); - integration_error = true; - return; - } + integration_error = true; + return; + } pabs_tol = abs_tol.fortran_vec (); prel_tol = rel_tol.fortran_vec (); @@ -320,56 +320,56 @@ static octave_idx_type *idummy = 0; F77_XFCN (ddasrt, DDASRT, (ddasrt_f, nn, t, px, pxdot, tout, pinfo, - prel_tol, pabs_tol, istate, prwork, lrw, - piwork, liw, dummy, idummy, ddasrt_j, - ddasrt_g, ng, pjroot)); + prel_tol, pabs_tol, istate, prwork, lrw, + piwork, liw, dummy, idummy, ddasrt_j, + ddasrt_g, ng, pjroot)); switch (istate) { case 1: // A step was successfully taken in intermediate-output - // mode. The code has not yet reached TOUT. + // mode. The code has not yet reached TOUT. case 2: // The integration to TOUT was successfully completed - // (T=TOUT) by stepping exactly to TOUT. + // (T=TOUT) by stepping exactly to TOUT. case 3: // The integration to TOUT was successfully completed - // (T=TOUT) by stepping past TOUT. Y(*) is obtained by - // interpolation. YPRIME(*) is obtained by interpolation. + // (T=TOUT) by stepping past TOUT. Y(*) is obtained by + // interpolation. YPRIME(*) is obtained by interpolation. t = tout; break; case 4: // The integration was successfully completed - // by finding one or more roots of G at T. + // by finding one or more roots of G at T. break; case -1: // A large amount of work has been expended. case -2: // The error tolerances are too stringent. case -3: // The local error test cannot be satisfied because you - // specified a zero component in ATOL and the - // corresponding computed solution component is zero. - // Thus, a pure relative error test is impossible for - // this component. + // specified a zero component in ATOL and the + // corresponding computed solution component is zero. + // Thus, a pure relative error test is impossible for + // this component. case -6: // DDASRT had repeated error test failures on the last - // attempted step. + // attempted step. case -7: // The corrector could not converge. case -8: // The matrix of partial derivatives is singular. case -9: // The corrector could not converge. There were repeated - // error test failures in this step. + // error test failures in this step. case -10: // The corrector could not converge because IRES was - // equal to minus one. + // equal to minus one. case -11: // IRES equal to -2 was encountered and control is being - // returned to the calling program. + // returned to the calling program. case -12: // DASSL failed to compute the initial YPRIME. case -33: // The code has encountered trouble from which it cannot - // recover. A message is printed explaining the trouble - // and control is returned to the calling program. For - // example, this occurs when invalid input is detected. + // recover. A message is printed explaining the trouble + // and control is returned to the calling program. For + // example, this occurs when invalid input is detected. integration_error = true; break; default: integration_error = true; (*current_liboctave_error_handler) - ("unrecognized value of istate (= %d) returned from ddasrt", - istate); + ("unrecognized value of istate (= %d) returned from ddasrt", + istate); break; } } @@ -392,40 +392,40 @@ xdot_out.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - { - x_out(0,i) = x(i); - xdot_out(0,i) = xdot(i); - } + { + x_out(0,i) = x(i); + xdot_out(0,i) = xdot(i); + } for (octave_idx_type j = 1; j < n_out; j++) - { - integrate (tout(j)); + { + integrate (tout(j)); - if (integration_error) - { - retval = DASRT_result (x_out, xdot_out, t_out); - return retval; - } + if (integration_error) + { + retval = DASRT_result (x_out, xdot_out, t_out); + return retval; + } if (istate == 4) t_out(j) = t; else t_out(j) = tout(j); - for (octave_idx_type i = 0; i < n; i++) - { - x_out(j,i) = x(i); - xdot_out(j,i) = xdot(i); - } + for (octave_idx_type i = 0; i < n; i++) + { + x_out(j,i) = x(i); + xdot_out(j,i) = xdot(i); + } if (istate == 4) - { - x_out.resize (j+1, n); - xdot_out.resize (j+1, n); - t_out.resize (j+1); - break; - } - } + { + x_out.resize (j+1, n); + xdot_out.resize (j+1, n); + t_out.resize (j+1); + break; + } + } } retval = DASRT_result (x_out, xdot_out, t_out); @@ -453,75 +453,75 @@ octave_idx_type n_crit = tcrit.capacity (); if (n_crit > 0) - { - octave_idx_type i_crit = 0; - octave_idx_type i_out = 1; - double next_crit = tcrit(0); - double next_out; - while (i_out < n_out) - { - bool do_restart = false; + { + octave_idx_type i_crit = 0; + octave_idx_type i_out = 1; + double next_crit = tcrit(0); + double next_out; + while (i_out < n_out) + { + bool do_restart = false; - next_out = tout(i_out); - if (i_crit < n_crit) - next_crit = tcrit(i_crit); + next_out = tout(i_out); + if (i_crit < n_crit) + next_crit = tcrit(i_crit); - octave_idx_type save_output; - double t_out; + octave_idx_type save_output; + double t_out; - if (next_crit == next_out) - { - set_stop_time (next_crit); - t_out = next_out; - save_output = 1; - i_out++; - i_crit++; - do_restart = true; - } - else if (next_crit < next_out) - { - if (i_crit < n_crit) - { - set_stop_time (next_crit); - t_out = next_crit; - save_output = 0; - i_crit++; - do_restart = true; - } - else - { - clear_stop_time (); - t_out = next_out; - save_output = 1; - i_out++; - } - } - else - { - set_stop_time (next_crit); - t_out = next_out; - save_output = 1; - i_out++; - } + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + i_crit++; + do_restart = true; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = 0; + i_crit++; + do_restart = true; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = 1; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + } - integrate (t_out); + integrate (t_out); - if (integration_error) - { - retval = DASRT_result (x_out, xdot_out, t_outs); - return retval; - } + if (integration_error) + { + retval = DASRT_result (x_out, xdot_out, t_outs); + return retval; + } if (istate == 4) t_out = t; - if (save_output) - { - for (octave_idx_type i = 0; i < n; i++) - { - x_out(i_out-1,i) = x(i); - xdot_out(i_out-1,i) = xdot(i); - } + if (save_output) + { + for (octave_idx_type i = 0; i < n; i++) + { + x_out(i_out-1,i) = x(i); + xdot_out(i_out-1,i) = xdot(i); + } t_outs(i_out-1) = t_out; @@ -532,21 +532,21 @@ t_outs.resize (i_out); i_out = n_out; } - } + } - if (do_restart) - force_restart (); - } + if (do_restart) + force_restart (); + } - retval = DASRT_result (x_out, xdot_out, t_outs); - } + retval = DASRT_result (x_out, xdot_out, t_outs); + } else - { - retval = integrate (tout); + { + retval = integrate (tout); - if (integration_error) - return retval; - } + if (integration_error) + return retval; + } } return retval; @@ -581,7 +581,7 @@ case -1: retval = std::string ("a large amount of work has been expended (t =") - + t_curr + ")"; + + t_curr + ")"; break; case -2: @@ -590,38 +590,38 @@ case -3: retval = std::string ("error weight became zero during problem. (t = ") - + t_curr - + "; solution component i vanished, and atol or atol(i) == 0)"; + + t_curr + + "; solution component i vanished, and atol or atol(i) == 0)"; break; case -6: retval = std::string ("repeated error test failures on the last attempted step (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -7: retval = std::string ("the corrector could not converge (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -8: retval = std::string ("the matrix of partial derivatives is singular (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -9: retval = std::string ("the corrector could not converge (t = ") - + t_curr + "; repeated test failures)"; + + t_curr + "; repeated test failures)"; break; case -10: retval = std::string ("corrector could not converge because IRES was -1 (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -11: retval = std::string ("return requested in user-supplied function (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -12:
--- a/liboctave/DASSL.cc +++ b/liboctave/DASSL.cc @@ -36,20 +36,20 @@ #include "quit.h" typedef octave_idx_type (*dassl_fcn_ptr) (const double&, const double*, const double*, - double*, octave_idx_type&, double*, octave_idx_type*); + double*, octave_idx_type&, double*, octave_idx_type*); typedef octave_idx_type (*dassl_jac_ptr) (const double&, const double*, const double*, - double*, const double&, double*, octave_idx_type*); + double*, const double&, double*, octave_idx_type*); extern "C" { F77_RET_T F77_FUNC (ddassl, DDASSL) (dassl_fcn_ptr, const octave_idx_type&, double&, - double*, double*, double&, const octave_idx_type*, - const double*, const double*, octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type*, const octave_idx_type&, - const double*, const octave_idx_type*, - dassl_jac_ptr); + double*, double*, double&, const octave_idx_type*, + const double*, const double*, octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type*, const octave_idx_type&, + const double*, const octave_idx_type*, + dassl_jac_ptr); } static DAEFunc::DAERHSFunc user_fun; @@ -59,7 +59,7 @@ static octave_idx_type ddassl_f (const double& time, const double *state, const double *deriv, - double *delta, octave_idx_type& ires, double *, octave_idx_type *) + double *delta, octave_idx_type& ires, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -80,12 +80,12 @@ if (ires >= 0) { if (tmp_delta.length () == 0) - ires = -2; + ires = -2; else - { - for (octave_idx_type i = 0; i < nn; i++) - delta [i] = tmp_delta.elem (i); - } + { + for (octave_idx_type i = 0; i < nn; i++) + delta [i] = tmp_delta.elem (i); + } } END_INTERRUPT_WITH_EXCEPTIONS; @@ -95,7 +95,7 @@ static octave_idx_type ddassl_j (const double& time, const double *state, const double *deriv, - double *pd, const double& cj, double *, octave_idx_type *) + double *pd, const double& cj, double *, octave_idx_type *) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -135,7 +135,7 @@ info.resize (15); for (octave_idx_type i = 0; i < 15; i++) - info(i) = 0; + info(i) = 0; pinfo = info.fortran_vec (); @@ -152,12 +152,12 @@ info(0) = 0; if (stop_time_set) - { - rwork(0) = stop_time; - info(3) = 1; - } + { + rwork(0) = stop_time; + info(3) = 1; + } else - info(3) = 0; + info(3) = 0; px = x.fortran_vec (); pxdot = xdot.fortran_vec (); @@ -173,28 +173,28 @@ user_jac = DAEFunc::jacobian_function (); if (user_fun) - { - octave_idx_type ires = 0; + { + octave_idx_type ires = 0; - ColumnVector res = (*user_fun) (x, xdot, t, ires); + ColumnVector res = (*user_fun) (x, xdot, t, ires); - if (res.length () != x.length ()) - { - (*current_liboctave_error_handler) - ("dassl: inconsistent sizes for state and residual vectors"); + if (res.length () != x.length ()) + { + (*current_liboctave_error_handler) + ("dassl: inconsistent sizes for state and residual vectors"); - integration_error = true; - return retval; - } - } + integration_error = true; + return retval; + } + } else - { - (*current_liboctave_error_handler) - ("dassl: no user supplied RHS subroutine!"); + { + (*current_liboctave_error_handler) + ("dassl: no user supplied RHS subroutine!"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } info(4) = user_jac ? 1 : 0; @@ -204,46 +204,46 @@ double hmax = maximum_step_size (); if (hmax >= 0.0) - { - rwork(1) = hmax; - info(6) = 1; - } + { + rwork(1) = hmax; + info(6) = 1; + } else - info(6) = 0; + info(6) = 0; double h0 = initial_step_size (); if (h0 >= 0.0) - { - rwork(2) = h0; - info(7) = 1; - } + { + rwork(2) = h0; + info(7) = 1; + } else - info(7) = 0; + info(7) = 0; if (step_limit () >= 0) - { - info(11) = 1; - iwork(20) = step_limit (); - } + { + info(11) = 1; + iwork(20) = step_limit (); + } else - info(11) = 0; + info(11) = 0; octave_idx_type maxord = maximum_order (); if (maxord >= 0) - { - if (maxord > 0 && maxord < 6) - { - info(8) = 1; - iwork(2) = maxord; - } - else - { - (*current_liboctave_error_handler) - ("dassl: invalid value for maximum order"); - integration_error = true; - return retval; - } - } + { + if (maxord > 0 && maxord < 6) + { + info(8) = 1; + iwork(2) = maxord; + } + else + { + (*current_liboctave_error_handler) + ("dassl: invalid value for maximum order"); + integration_error = true; + return retval; + } + } octave_idx_type enc = enforce_nonnegativity_constraints (); info(9) = enc ? 1 : 0; @@ -258,21 +258,21 @@ octave_idx_type rel_tol_len = rel_tol.length (); if (abs_tol_len == 1 && rel_tol_len == 1) - { - info(1) = 0; - } + { + info(1) = 0; + } else if (abs_tol_len == n && rel_tol_len == n) - { - info(1) = 1; - } + { + info(1) = 1; + } else - { - (*current_liboctave_error_handler) - ("dassl: inconsistent sizes for tolerance arrays"); + { + (*current_liboctave_error_handler) + ("dassl: inconsistent sizes for tolerance arrays"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } pabs_tol = abs_tol.fortran_vec (); prel_tol = rel_tol.fortran_vec (); @@ -284,18 +284,18 @@ static octave_idx_type *idummy = 0; F77_XFCN (ddassl, DDASSL, (ddassl_f, nn, t, px, pxdot, tout, pinfo, - prel_tol, pabs_tol, istate, prwork, lrw, - piwork, liw, dummy, idummy, ddassl_j)); + prel_tol, pabs_tol, istate, prwork, lrw, + piwork, liw, dummy, idummy, ddassl_j)); switch (istate) { case 1: // A step was successfully taken in intermediate-output - // mode. The code has not yet reached TOUT. + // mode. The code has not yet reached TOUT. case 2: // The integration to TSTOP was successfully completed - // (T=TSTOP) by stepping exactly to TSTOP. + // (T=TSTOP) by stepping exactly to TSTOP. case 3: // The integration to TOUT was successfully completed - // (T=TOUT) by stepping past TOUT. Y(*) is obtained by - // interpolation. YPRIME(*) is obtained by interpolation. + // (T=TOUT) by stepping past TOUT. Y(*) is obtained by + // interpolation. YPRIME(*) is obtained by interpolation. retval = x; t = tout; break; @@ -303,33 +303,33 @@ case -1: // A large amount of work has been expended. (~500 steps). case -2: // The error tolerances are too stringent. case -3: // The local error test cannot be satisfied because you - // specified a zero component in ATOL and the - // corresponding computed solution component is zero. - // Thus, a pure relative error test is impossible for - // this component. + // specified a zero component in ATOL and the + // corresponding computed solution component is zero. + // Thus, a pure relative error test is impossible for + // this component. case -6: // DDASSL had repeated error test failures on the last - // attempted step. + // attempted step. case -7: // The corrector could not converge. case -8: // The matrix of partial derivatives is singular. case -9: // The corrector could not converge. There were repeated - // error test failures in this step. + // error test failures in this step. case -10: // The corrector could not converge because IRES was - // equal to minus one. + // equal to minus one. case -11: // IRES equal to -2 was encountered and control is being - // returned to the calling program. + // returned to the calling program. case -12: // DDASSL failed to compute the initial YPRIME. case -33: // The code has encountered trouble from which it cannot - // recover. A message is printed explaining the trouble - // and control is returned to the calling program. For - // example, this occurs when invalid input is detected. + // recover. A message is printed explaining the trouble + // and control is returned to the calling program. For + // example, this occurs when invalid input is detected. integration_error = true; break; default: integration_error = true; (*current_liboctave_error_handler) - ("unrecognized value of istate (= %d) returned from ddassl", - istate); + ("unrecognized value of istate (= %d) returned from ddassl", + istate); break; } @@ -357,24 +357,24 @@ xdot_out.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (0, i) = x.elem (i); - xdot_out.elem (0, i) = xdot.elem (i); - } + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } for (octave_idx_type j = 1; j < n_out; j++) - { - ColumnVector x_next = do_integrate (tout.elem (j)); + { + ColumnVector x_next = do_integrate (tout.elem (j)); - if (integration_error) - return retval; + if (integration_error) + return retval; - for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (j, i) = x_next.elem (i); - xdot_out.elem (j, i) = xdot.elem (i); - } - } + for (octave_idx_type i = 0; i < n; i++) + { + retval.elem (j, i) = x_next.elem (i); + xdot_out.elem (j, i) = xdot.elem (i); + } + } } return retval; @@ -389,7 +389,7 @@ Matrix DASSL::integrate (const ColumnVector& tout, Matrix& xdot_out, - const ColumnVector& tcrit) + const ColumnVector& tcrit) { Matrix retval; @@ -402,90 +402,90 @@ xdot_out.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (0, i) = x.elem (i); - xdot_out.elem (0, i) = xdot.elem (i); - } + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } octave_idx_type n_crit = tcrit.capacity (); if (n_crit > 0) - { - octave_idx_type i_crit = 0; - octave_idx_type i_out = 1; - double next_crit = tcrit.elem (0); - double next_out; - while (i_out < n_out) - { - bool do_restart = false; + { + octave_idx_type i_crit = 0; + octave_idx_type i_out = 1; + double next_crit = tcrit.elem (0); + double next_out; + while (i_out < n_out) + { + bool do_restart = false; - next_out = tout.elem (i_out); - if (i_crit < n_crit) - next_crit = tcrit.elem (i_crit); + next_out = tout.elem (i_out); + if (i_crit < n_crit) + next_crit = tcrit.elem (i_crit); - bool save_output; - double t_out; + bool save_output; + double t_out; - if (next_crit == next_out) - { - set_stop_time (next_crit); - t_out = next_out; - save_output = true; - i_out++; - i_crit++; - do_restart = true; - } - else if (next_crit < next_out) - { - if (i_crit < n_crit) - { - set_stop_time (next_crit); - t_out = next_crit; - save_output = false; - i_crit++; - do_restart = true; - } - else - { - clear_stop_time (); - t_out = next_out; - save_output = true; - i_out++; - } - } - else - { - set_stop_time (next_crit); - t_out = next_out; - save_output = true; - i_out++; - } + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = true; + i_out++; + i_crit++; + do_restart = true; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = false; + i_crit++; + do_restart = true; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = true; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = true; + i_out++; + } - ColumnVector x_next = do_integrate (t_out); + ColumnVector x_next = do_integrate (t_out); - if (integration_error) - return retval; + if (integration_error) + return retval; - if (save_output) - { - for (octave_idx_type i = 0; i < n; i++) - { - retval.elem (i_out-1, i) = x_next.elem (i); - xdot_out.elem (i_out-1, i) = xdot.elem (i); - } - } + if (save_output) + { + for (octave_idx_type i = 0; i < n; i++) + { + retval.elem (i_out-1, i) = x_next.elem (i); + xdot_out.elem (i_out-1, i) = xdot.elem (i); + } + } - if (do_restart) - force_restart (); - } - } + if (do_restart) + force_restart (); + } + } else - { - retval = integrate (tout, xdot_out); + { + retval = integrate (tout, xdot_out); - if (integration_error) - return retval; - } + if (integration_error) + return retval; + } } return retval; @@ -516,7 +516,7 @@ case -1: retval = std::string ("a large amount of work has been expended (t =") - + t_curr + ")"; + + t_curr + ")"; break; case -2: @@ -525,38 +525,38 @@ case -3: retval = std::string ("error weight became zero during problem. (t = ") - + t_curr - + "; solution component i vanished, and atol or atol(i) == 0)"; + + t_curr + + "; solution component i vanished, and atol or atol(i) == 0)"; break; case -6: retval = std::string ("repeated error test failures on the last attempted step (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -7: retval = std::string ("the corrector could not converge (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -8: retval = std::string ("the matrix of partial derivatives is singular (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -9: retval = std::string ("the corrector could not converge (t = ") - + t_curr + "; repeated test failures)"; + + t_curr + "; repeated test failures)"; break; case -10: retval = std::string ("corrector could not converge because IRES was -1 (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -11: retval = std::string ("return requested in user-supplied function (t = ") - + t_curr + ")"; + + t_curr + ")"; break; case -12:
--- a/liboctave/EIG.cc +++ b/liboctave/EIG.cc @@ -34,99 +34,99 @@ { F77_RET_T F77_FUNC (dgeev, DGEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, double*, - double*, double*, const octave_idx_type&, double*, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, double*, const octave_idx_type&, double*, + double*, double*, const octave_idx_type&, double*, + const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zgeev, ZGEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, const octave_idx_type&, Complex*, - Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, Complex*, const octave_idx_type&, Complex*, + Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dsyev, DSYEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, double*, - double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, double*, const octave_idx_type&, double*, + double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zheev, ZHEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, Complex*, const octave_idx_type&, double*, - Complex*, const octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, Complex*, const octave_idx_type&, double*, + Complex*, const octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpotrf, DPOTRF) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - double*, const octave_idx_type&, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, + double*, const octave_idx_type&, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - Complex*, const octave_idx_type&, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, + Complex*, const octave_idx_type&, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dggev, DGGEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - double*, const octave_idx_type&, - double*, const octave_idx_type&, - double*, double*, double *, - double*, const octave_idx_type&, double*, const octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, + double*, const octave_idx_type&, + double*, const octave_idx_type&, + double*, double*, double *, + double*, const octave_idx_type&, double*, const octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dsygv, DSYGV) (const octave_idx_type&, - F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - double*, const octave_idx_type&, - double*, const octave_idx_type&, - double*, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, + double*, const octave_idx_type&, + double*, const octave_idx_type&, + double*, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zggev, ZGGEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, - Complex*, Complex*, - Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, + Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, + Complex*, Complex*, + Complex*, const octave_idx_type&, Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zhegv, ZHEGV) (const octave_idx_type&, - F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - Complex*, const octave_idx_type&, - Complex*, const octave_idx_type&, - double*, Complex*, const octave_idx_type&, double*, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, + Complex*, const octave_idx_type&, + Complex*, const octave_idx_type&, + double*, Complex*, const octave_idx_type&, double*, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type @@ -135,7 +135,7 @@ if (a.any_element_is_inf_or_nan ()) { (*current_liboctave_error_handler) - ("EIG: matrix contains Inf or NaN values"); + ("EIG: matrix contains Inf or NaN values"); return -1; } @@ -172,11 +172,11 @@ octave_idx_type idummy = 1; F77_XFCN (dgeev, DGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, tmp_data, n, pwr, pwi, dummy, - idummy, pvr, n, &dummy_work, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, tmp_data, n, pwr, pwi, dummy, + idummy, pvr, n, &dummy_work, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -185,57 +185,57 @@ double *pwork = work.fortran_vec (); F77_XFCN (dgeev, DGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, tmp_data, n, pwr, pwi, dummy, - idummy, pvr, n, pwork, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, tmp_data, n, pwr, pwi, dummy, + idummy, pvr, n, pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in dgeev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in dgeev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("dgeev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("dgeev failed to converge"); + return info; + } lambda.resize (n); octave_idx_type nvr = calc_ev ? n : 0; v.resize (nvr, nvr); for (octave_idx_type j = 0; j < n; j++) - { - if (wi.elem (j) == 0.0) - { - lambda.elem (j) = Complex (wr.elem (j)); - for (octave_idx_type i = 0; i < nvr; i++) - v.elem (i, j) = vr.elem (i, j); - } - else - { - if (j+1 >= n) - { - (*current_liboctave_error_handler) ("EIG: internal error"); - return -1; - } + { + if (wi.elem (j) == 0.0) + { + lambda.elem (j) = Complex (wr.elem (j)); + for (octave_idx_type i = 0; i < nvr; i++) + v.elem (i, j) = vr.elem (i, j); + } + else + { + if (j+1 >= n) + { + (*current_liboctave_error_handler) ("EIG: internal error"); + return -1; + } - lambda.elem(j) = Complex (wr.elem(j), wi.elem(j)); - lambda.elem(j+1) = Complex (wr.elem(j+1), wi.elem(j+1)); + lambda.elem(j) = Complex (wr.elem(j), wi.elem(j)); + lambda.elem(j+1) = Complex (wr.elem(j+1), wi.elem(j+1)); - for (octave_idx_type i = 0; i < nvr; i++) - { - double real_part = vr.elem (i, j); - double imag_part = vr.elem (i, j+1); - v.elem (i, j) = Complex (real_part, imag_part); - v.elem (i, j+1) = Complex (real_part, -imag_part); - } - j++; - } - } + for (octave_idx_type i = 0; i < nvr; i++) + { + double real_part = vr.elem (i, j); + double imag_part = vr.elem (i, j+1); + v.elem (i, j) = Complex (real_part, imag_part); + v.elem (i, j+1) = Complex (real_part, -imag_part); + } + j++; + } + } } else (*current_liboctave_error_handler) ("dgeev workspace query failed"); @@ -266,10 +266,10 @@ double dummy_work; F77_XFCN (dsyev, DSYEV, (F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, tmp_data, n, pwr, &dummy_work, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, &dummy_work, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -278,22 +278,22 @@ double *pwork = work.fortran_vec (); F77_XFCN (dsyev, DSYEV, (F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, tmp_data, n, pwr, pwork, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in dsyev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in dsyev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("dsyev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("dsyev failed to converge"); + return info; + } lambda = ComplexColumnVector (wr); v = calc_ev ? ComplexMatrix (atmp) : ComplexMatrix (); @@ -310,7 +310,7 @@ if (a.any_element_is_inf_or_nan ()) { (*current_liboctave_error_handler) - ("EIG: matrix contains Inf or NaN values"); + ("EIG: matrix contains Inf or NaN values"); return -1; } @@ -348,11 +348,11 @@ octave_idx_type idummy = 1; F77_XFCN (zgeev, ZGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, tmp_data, n, pw, dummy, idummy, - pv, n, &dummy_work, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, tmp_data, n, pw, dummy, idummy, + pv, n, &dummy_work, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -361,23 +361,23 @@ Complex *pwork = work.fortran_vec (); F77_XFCN (zgeev, ZGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, tmp_data, n, pw, dummy, idummy, - pv, n, pwork, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, tmp_data, n, pw, dummy, idummy, + pv, n, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in zgeev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in zgeev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("zgeev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("zgeev failed to converge"); + return info; + } lambda = w; v = vtmp; @@ -415,11 +415,11 @@ double *prwork = rwork.fortran_vec (); F77_XFCN (zheev, ZHEEV, (F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, tmp_data, n, pwr, &dummy_work, lwork, - prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, &dummy_work, lwork, + prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -428,22 +428,22 @@ Complex *pwork = work.fortran_vec (); F77_XFCN (zheev, ZHEEV, (F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, tmp_data, n, pwr, pwork, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in zheev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in zheev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("zheev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("zheev failed to converge"); + return info; + } lambda = ComplexColumnVector (wr); v = calc_ev ? ComplexMatrix (atmp) : ComplexMatrix (); @@ -460,7 +460,7 @@ if (a.any_element_is_inf_or_nan () || b.any_element_is_inf_or_nan ()) { (*current_liboctave_error_handler) - ("EIG: matrix contains Inf or NaN values"); + ("EIG: matrix contains Inf or NaN values"); return -1; } @@ -485,10 +485,10 @@ double *tmp_data = tmp.fortran_vec (); F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), - n, tmp_data, n, - info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + n, tmp_data, n, + info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (a.is_symmetric () && b.is_symmetric () && info == 0) return symmetric_init (a, b, calc_ev); @@ -519,13 +519,13 @@ octave_idx_type idummy = 1; F77_XFCN (dggev, DGGEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, atmp_data, n, btmp_data, n, - par, pai, pbeta, - dummy, idummy, pvr, n, - &dummy_work, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, atmp_data, n, btmp_data, n, + par, pai, pbeta, + dummy, idummy, pvr, n, + &dummy_work, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -534,61 +534,61 @@ double *pwork = work.fortran_vec (); F77_XFCN (dggev, DGGEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, atmp_data, n, btmp_data, n, - par, pai, pbeta, - dummy, idummy, pvr, n, - pwork, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, atmp_data, n, btmp_data, n, + par, pai, pbeta, + dummy, idummy, pvr, n, + pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in dggev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in dggev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("dggev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("dggev failed to converge"); + return info; + } lambda.resize (n); octave_idx_type nvr = calc_ev ? n : 0; v.resize (nvr, nvr); for (octave_idx_type j = 0; j < n; j++) - { - if (ai.elem (j) == 0.0) - { - lambda.elem (j) = Complex (ar.elem (j) / beta.elem (j)); - for (octave_idx_type i = 0; i < nvr; i++) - v.elem (i, j) = vr.elem (i, j); - } - else - { - if (j+1 >= n) - { - (*current_liboctave_error_handler) ("EIG: internal error"); - return -1; - } + { + if (ai.elem (j) == 0.0) + { + lambda.elem (j) = Complex (ar.elem (j) / beta.elem (j)); + for (octave_idx_type i = 0; i < nvr; i++) + v.elem (i, j) = vr.elem (i, j); + } + else + { + if (j+1 >= n) + { + (*current_liboctave_error_handler) ("EIG: internal error"); + return -1; + } - lambda.elem(j) = Complex (ar.elem(j) / beta.elem (j), - ai.elem(j) / beta.elem (j)); - lambda.elem(j+1) = Complex (ar.elem(j+1) / beta.elem (j+1), - ai.elem(j+1) / beta.elem (j+1)); + lambda.elem(j) = Complex (ar.elem(j) / beta.elem (j), + ai.elem(j) / beta.elem (j)); + lambda.elem(j+1) = Complex (ar.elem(j+1) / beta.elem (j+1), + ai.elem(j+1) / beta.elem (j+1)); - for (octave_idx_type i = 0; i < nvr; i++) - { - double real_part = vr.elem (i, j); - double imag_part = vr.elem (i, j+1); - v.elem (i, j) = Complex (real_part, imag_part); - v.elem (i, j+1) = Complex (real_part, -imag_part); - } - j++; - } - } + for (octave_idx_type i = 0; i < nvr; i++) + { + double real_part = vr.elem (i, j); + double imag_part = vr.elem (i, j+1); + v.elem (i, j) = Complex (real_part, imag_part); + v.elem (i, j+1) = Complex (real_part, -imag_part); + } + j++; + } + } } else (*current_liboctave_error_handler) ("dggev workspace query failed"); @@ -629,12 +629,12 @@ double dummy_work; F77_XFCN (dsygv, DSYGV, (1, F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, atmp_data, n, - btmp_data, n, - pwr, &dummy_work, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, atmp_data, n, + btmp_data, n, + pwr, &dummy_work, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -643,24 +643,24 @@ double *pwork = work.fortran_vec (); F77_XFCN (dsygv, DSYGV, (1, F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, atmp_data, n, - btmp_data, n, - pwr, pwork, lwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, atmp_data, n, + btmp_data, n, + pwr, pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in dsygv"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in dsygv"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("dsygv failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("dsygv failed to converge"); + return info; + } lambda = ComplexColumnVector (wr); v = calc_ev ? ComplexMatrix (atmp) : ComplexMatrix (); @@ -677,7 +677,7 @@ if (a.any_element_is_inf_or_nan () || b.any_element_is_inf_or_nan ()) { (*current_liboctave_error_handler) - ("EIG: matrix contains Inf or NaN values"); + ("EIG: matrix contains Inf or NaN values"); return -1; } @@ -702,10 +702,10 @@ Complex*tmp_data = tmp.fortran_vec (); F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), - n, tmp_data, n, - info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + n, tmp_data, n, + info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (a.is_hermitian () && b.is_hermitian () && info == 0) return hermitian_init (a, calc_ev); @@ -737,12 +737,12 @@ octave_idx_type idummy = 1; F77_XFCN (zggev, ZGGEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, atmp_data, n, btmp_data, n, - palpha, pbeta, dummy, idummy, - pv, n, &dummy_work, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, atmp_data, n, btmp_data, n, + palpha, pbeta, dummy, idummy, + pv, n, &dummy_work, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -751,24 +751,24 @@ Complex *pwork = work.fortran_vec (); F77_XFCN (zggev, ZGGEV, (F77_CONST_CHAR_ARG2 ("N", 1), - F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - n, atmp_data, n, btmp_data, n, - palpha, pbeta, dummy, idummy, - pv, n, pwork, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), + n, atmp_data, n, btmp_data, n, + palpha, pbeta, dummy, idummy, + pv, n, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in zggev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in zggev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("zggev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("zggev failed to converge"); + return info; + } lambda.resize (n); @@ -820,13 +820,13 @@ double *prwork = rwork.fortran_vec (); F77_XFCN (zhegv, ZHEGV, (1, F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, atmp_data, n, - btmp_data, n, - pwr, &dummy_work, lwork, - prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, atmp_data, n, + btmp_data, n, + pwr, &dummy_work, lwork, + prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info == 0) { @@ -835,24 +835,24 @@ Complex *pwork = work.fortran_vec (); F77_XFCN (zhegv, ZHEGV, (1, F77_CONST_CHAR_ARG2 (calc_ev ? "V" : "N", 1), - F77_CONST_CHAR_ARG2 ("U", 1), - n, atmp_data, n, - btmp_data, n, - pwr, pwork, lwork, prwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_CONST_CHAR_ARG2 ("U", 1), + n, atmp_data, n, + btmp_data, n, + pwr, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (info < 0) - { - (*current_liboctave_error_handler) ("unrecoverable error in zhegv"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in zhegv"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("zhegv failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("zhegv failed to converge"); + return info; + } lambda = ComplexColumnVector (wr); v = calc_ev ? ComplexMatrix (atmp) : ComplexMatrix ();
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -36,19 +36,19 @@ #include "quit.h" typedef octave_idx_type (*lsode_fcn_ptr) (const octave_idx_type&, const double&, double*, - double*, octave_idx_type&); + double*, octave_idx_type&); typedef octave_idx_type (*lsode_jac_ptr) (const octave_idx_type&, const double&, double*, - const octave_idx_type&, const octave_idx_type&, double*, const - octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, double*, const + octave_idx_type&); extern "C" { F77_RET_T F77_FUNC (dlsode, DLSODE) (lsode_fcn_ptr, octave_idx_type&, double*, double&, - double&, octave_idx_type&, double&, const double*, octave_idx_type&, - octave_idx_type&, octave_idx_type&, double*, octave_idx_type&, octave_idx_type*, octave_idx_type&, - lsode_jac_ptr, octave_idx_type&); + double&, octave_idx_type&, double&, const double*, octave_idx_type&, + octave_idx_type&, octave_idx_type&, double*, octave_idx_type&, octave_idx_type*, octave_idx_type&, + lsode_jac_ptr, octave_idx_type&); } static ODEFunc::ODERHSFunc user_fun; @@ -57,7 +57,7 @@ static octave_idx_type lsode_f (const octave_idx_type& neq, const double& time, double *, - double *deriv, octave_idx_type& ierr) + double *deriv, octave_idx_type& ierr) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -74,7 +74,7 @@ else { for (octave_idx_type i = 0; i < neq; i++) - deriv [i] = tmp_deriv.elem (i); + deriv [i] = tmp_deriv.elem (i); } END_INTERRUPT_WITH_EXCEPTIONS; @@ -84,7 +84,7 @@ static octave_idx_type lsode_j (const octave_idx_type& neq, const double& time, double *, - const octave_idx_type&, const octave_idx_type&, double *pd, const octave_idx_type& nrowpd) + const octave_idx_type&, const octave_idx_type&, double *pd, const octave_idx_type& nrowpd) { BEGIN_INTERRUPT_WITH_EXCEPTIONS; @@ -127,65 +127,65 @@ octave_idx_type max_maxord = 0; if (integration_method () == "stiff") - { - max_maxord = 5; + { + max_maxord = 5; - if (jac) - method_flag = 21; - else - method_flag = 22; + if (jac) + method_flag = 21; + else + method_flag = 22; - liw = 20 + n; - lrw = 22 + n * (9 + n); - } + liw = 20 + n; + lrw = 22 + n * (9 + n); + } else - { - max_maxord = 12; + { + max_maxord = 12; - method_flag = 10; + method_flag = 10; - liw = 20; - lrw = 22 + 16 * n; - } + liw = 20; + lrw = 22 + 16 * n; + } maxord = maximum_order (); iwork.resize (liw); for (octave_idx_type i = 4; i < 9; i++) - iwork(i) = 0; + iwork(i) = 0; rwork.resize (lrw); for (octave_idx_type i = 4; i < 9; i++) - rwork(i) = 0; + rwork(i) = 0; if (maxord >= 0) - { - if (maxord > 0 && maxord <= max_maxord) - { - iwork(4) = maxord; - iopt = 1; - } - else - { - (*current_liboctave_error_handler) - ("lsode: invalid value for maximum order"); - integration_error = true; - return retval; - } - } + { + if (maxord > 0 && maxord <= max_maxord) + { + iwork(4) = maxord; + iopt = 1; + } + else + { + (*current_liboctave_error_handler) + ("lsode: invalid value for maximum order"); + integration_error = true; + return retval; + } + } if (stop_time_set) - { - itask = 4; - rwork(0) = stop_time; - iopt = 1; - } + { + itask = 4; + rwork(0) = stop_time; + iopt = 1; + } else - { - itask = 1; - } + { + itask = 1; + } px = x.fortran_vec (); @@ -208,13 +208,13 @@ ColumnVector xdot = (*user_fun) (x, t); if (x.length () != xdot.length ()) - { - (*current_liboctave_error_handler) - ("lsode: inconsistent sizes for state and derivative vectors"); + { + (*current_liboctave_error_handler) + ("lsode: inconsistent sizes for state and derivative vectors"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } ODEFunc::reset = false; @@ -226,45 +226,45 @@ octave_idx_type abs_tol_len = abs_tol.length (); if (abs_tol_len == 1) - itol = 1; + itol = 1; else if (abs_tol_len == n) - itol = 2; + itol = 2; else - { - (*current_liboctave_error_handler) - ("lsode: inconsistent sizes for state and absolute tolerance vectors"); + { + (*current_liboctave_error_handler) + ("lsode: inconsistent sizes for state and absolute tolerance vectors"); - integration_error = true; - return retval; - } + integration_error = true; + return retval; + } double iss = initial_step_size (); if (iss >= 0.0) - { - rwork(4) = iss; - iopt = 1; - } + { + rwork(4) = iss; + iopt = 1; + } double maxss = maximum_step_size (); if (maxss >= 0.0) - { - rwork(5) = maxss; - iopt = 1; - } + { + rwork(5) = maxss; + iopt = 1; + } double minss = minimum_step_size (); if (minss >= 0.0) - { - rwork(6) = minss; - iopt = 1; - } + { + rwork(6) = minss; + iopt = 1; + } octave_idx_type sl = step_limit (); if (sl > 0) - { - iwork(5) = sl; - iopt = 1; - } + { + iwork(5) = sl; + iopt = 1; + } pabs_tol = abs_tol.fortran_vec (); @@ -272,8 +272,8 @@ } F77_XFCN (dlsode, DLSODE, (lsode_f, nn, px, t, tout, itol, rel_tol, - pabs_tol, itask, istate, iopt, prwork, lrw, - piwork, liw, lsode_j, method_flag)); + pabs_tol, itask, istate, iopt, prwork, lrw, + piwork, liw, lsode_j, method_flag)); switch (istate) { @@ -288,9 +288,9 @@ case -3: // invalid input detected (see printed message). case -4: // repeated error test failures (check all inputs). case -5: // repeated convergence failures (perhaps bad jacobian - // supplied or wrong choice of mf or tolerances). + // supplied or wrong choice of mf or tolerances). case -6: // error weight became zero during problem. (solution - // component i vanished, and atol or atol(i) = 0.) + // component i vanished, and atol or atol(i) = 0.) case -13: // return requested in user-supplied function. integration_error = true; break; @@ -298,8 +298,8 @@ default: integration_error = true; (*current_liboctave_error_handler) - ("unrecognized value of istate (= %d) returned from lsode", - istate); + ("unrecognized value of istate (= %d) returned from lsode", + istate); break; } @@ -324,14 +324,14 @@ case 2: retval = "successful exit"; break; - + case 3: retval = "prior to continuation call with modified parameters"; break; - + case -1: retval = std::string ("excess work on this call (t = ") - + t_curr + "; perhaps wrong integration method)"; + + t_curr + "; perhaps wrong integration method)"; break; case -2: @@ -344,24 +344,24 @@ case -4: retval = std::string ("repeated error test failures (t = ") - + t_curr + "check all inputs)"; + + t_curr + "check all inputs)"; break; case -5: retval = std::string ("repeated convergence failures (t = ") - + t_curr - + "perhaps bad jacobian supplied or wrong choice of integration method or tolerances)"; + + t_curr + + "perhaps bad jacobian supplied or wrong choice of integration method or tolerances)"; break; case -6: retval = std::string ("error weight became zero during problem. (t = ") - + t_curr - + "; solution component i vanished, and atol or atol(i) == 0)"; + + t_curr + + "; solution component i vanished, and atol or atol(i) == 0)"; break; case -13: retval = "return requested in user-supplied function (t = " - + t_curr + ")"; + + t_curr + ")"; break; default: @@ -385,18 +385,18 @@ retval.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - retval.elem (0, i) = x.elem (i); + retval.elem (0, i) = x.elem (i); for (octave_idx_type j = 1; j < n_out; j++) - { - ColumnVector x_next = do_integrate (tout.elem (j)); + { + ColumnVector x_next = do_integrate (tout.elem (j)); - if (integration_error) - return retval; + if (integration_error) + return retval; - for (octave_idx_type i = 0; i < n; i++) - retval.elem (j, i) = x_next.elem (i); - } + for (octave_idx_type i = 0; i < n; i++) + retval.elem (j, i) = x_next.elem (i); + } } return retval; @@ -415,84 +415,84 @@ retval.resize (n_out, n); for (octave_idx_type i = 0; i < n; i++) - retval.elem (0, i) = x.elem (i); + retval.elem (0, i) = x.elem (i); octave_idx_type n_crit = tcrit.capacity (); if (n_crit > 0) - { - octave_idx_type i_crit = 0; - octave_idx_type i_out = 1; - double next_crit = tcrit.elem (0); - double next_out; - while (i_out < n_out) - { - bool do_restart = false; + { + octave_idx_type i_crit = 0; + octave_idx_type i_out = 1; + double next_crit = tcrit.elem (0); + double next_out; + while (i_out < n_out) + { + bool do_restart = false; - next_out = tout.elem (i_out); - if (i_crit < n_crit) - next_crit = tcrit.elem (i_crit); + next_out = tout.elem (i_out); + if (i_crit < n_crit) + next_crit = tcrit.elem (i_crit); - octave_idx_type save_output; - double t_out; + octave_idx_type save_output; + double t_out; - if (next_crit == next_out) - { - set_stop_time (next_crit); - t_out = next_out; - save_output = 1; - i_out++; - i_crit++; - do_restart = true; - } - else if (next_crit < next_out) - { - if (i_crit < n_crit) - { - set_stop_time (next_crit); - t_out = next_crit; - save_output = 0; - i_crit++; - do_restart = true; - } - else - { - clear_stop_time (); - t_out = next_out; - save_output = 1; - i_out++; - } - } - else - { - set_stop_time (next_crit); - t_out = next_out; - save_output = 1; - i_out++; - } + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + i_crit++; + do_restart = true; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = 0; + i_crit++; + do_restart = true; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = 1; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + } - ColumnVector x_next = do_integrate (t_out); + ColumnVector x_next = do_integrate (t_out); - if (integration_error) - return retval; + if (integration_error) + return retval; - if (save_output) - { - for (octave_idx_type i = 0; i < n; i++) - retval.elem (i_out-1, i) = x_next.elem (i); - } + if (save_output) + { + for (octave_idx_type i = 0; i < n; i++) + retval.elem (i_out-1, i) = x_next.elem (i); + } - if (do_restart) - force_restart (); - } - } + if (do_restart) + force_restart (); + } + } else - { - retval = do_integrate (tout); + { + retval = do_integrate (tout); - if (integration_error) - return retval; - } + if (integration_error) + return retval; + } } return retval;
--- a/liboctave/MSparse.cc +++ b/liboctave/MSparse.cc @@ -81,16 +81,16 @@ else if (( !ja_lt_max ) || (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. + b.data(jb); - jx++; + r.ridx(jx) = b.ridx(jb); + r.data(jx) = 0. + b.data(jb); + jx++; jb++; jb_lt_max= jb < jb_max; } else { - if ((a.data(ja) + b.data(jb)) != 0.) - { + if ((a.data(ja) + b.data(jb)) != 0.) + { r.data(jx) = a.data(ja) + b.data(jb); r.ridx(jx) = a.ridx(ja); jx++; @@ -104,7 +104,7 @@ r.cidx(i+1) = jx; } - a = r.maybe_compress (); + a = r.maybe_compress (); } return a; @@ -154,16 +154,16 @@ else if (( !ja_lt_max ) || (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. - b.data(jb); - jx++; + r.ridx(jx) = b.ridx(jb); + r.data(jx) = 0. - b.data(jb); + jx++; jb++; jb_lt_max= jb < jb_max; } else { - if ((a.data(ja) - b.data(jb)) != 0.) - { + if ((a.data(ja) - b.data(jb)) != 0.) + { r.data(jx) = a.data(ja) - b.data(jb); r.ridx(jx) = a.ridx(ja); jx++; @@ -177,7 +177,7 @@ r.cidx(i+1) = jx; } - a = r.maybe_compress (); + a = r.maybe_compress (); } return a; @@ -193,11 +193,11 @@ octave_idx_type nr = a.rows (); \ octave_idx_type nc = a.cols (); \ \ - MArray2<T> r (nr, nc, (0.0 OP s)); \ + MArray2<T> r (nr, nc, (0.0 OP s)); \ \ for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = a.data (i) OP s; \ + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ + r.elem (a.ridx (i), j) = a.data (i) OP s; \ return r; \ } @@ -214,8 +214,8 @@ \ for (octave_idx_type i = 0; i < nz; i++) \ { \ - r.data(i) = a.data(i) OP s; \ - r.ridx(i) = a.ridx(i); \ + r.data(i) = a.data(i) OP s; \ + r.ridx(i) = a.ridx(i); \ } \ for (octave_idx_type i = 0; i < nc + 1; i++) \ r.cidx(i) = a.cidx(i); \ @@ -239,11 +239,11 @@ octave_idx_type nr = a.rows (); \ octave_idx_type nc = a.cols (); \ \ - MArray2<T> r (nr, nc, (s OP 0.0)); \ + MArray2<T> r (nr, nc, (s OP 0.0)); \ \ for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = s OP a.data (i); \ + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ + r.elem (a.ridx (i), j) = s OP a.data (i); \ return r; \ } @@ -260,8 +260,8 @@ \ for (octave_idx_type i = 0; i < nz; i++) \ { \ - r.data(i) = s OP a.data(i); \ - r.ridx(i) = a.ridx(i); \ + r.data(i) = s OP a.data(i); \ + r.ridx(i) = a.ridx(i); \ } \ for (octave_idx_type i = 0; i < nc + 1; i++) \ r.cidx(i) = a.cidx(i); \ @@ -295,7 +295,7 @@ r = OP MSparse<T> (b); \ else \ { \ - r = MSparse<T> (b_nr, b_nc, a.data(0) OP 0.); \ + r = MSparse<T> (b_nr, b_nc, a.data(0) OP 0.); \ \ for (octave_idx_type j = 0 ; j < b_nc ; j++) \ { \ @@ -305,7 +305,7 @@ { \ octave_quit (); \ r.data(idxj + b.ridx(i)) = a.data(0) OP b.data(i); \ - } \ + } \ } \ r.maybe_compress (); \ } \ @@ -316,7 +316,7 @@ r = MSparse<T> (a); \ else \ { \ - r = MSparse<T> (a_nr, a_nc, 0. OP b.data(0)); \ + r = MSparse<T> (a_nr, a_nc, 0. OP b.data(0)); \ \ for (octave_idx_type j = 0 ; j < a_nc ; j++) \ { \ @@ -326,7 +326,7 @@ { \ octave_quit (); \ r.data(idxj + a.ridx(i)) = a.data(i) OP b.data(0); \ - } \ + } \ } \ r.maybe_compress (); \ } \ @@ -338,7 +338,7 @@ r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); \ \ octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ + r.cidx (0) = 0; \ for (octave_idx_type i = 0 ; i < a_nc ; i++) \ { \ octave_idx_type ja = a.cidx(i); \ @@ -364,16 +364,16 @@ else if (( !ja_lt_max ) || \ (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ { \ - r.ridx(jx) = b.ridx(jb); \ - r.data(jx) = 0. OP b.data(jb); \ - jx++; \ + r.ridx(jx) = b.ridx(jb); \ + r.data(jx) = 0. OP b.data(jb); \ + jx++; \ jb++; \ jb_lt_max= jb < jb_max; \ } \ else \ { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ + if ((a.data(ja) OP b.data(jb)) != 0.) \ + { \ r.data(jx) = a.data(ja) OP b.data(jb); \ r.ridx(jx) = a.ridx(ja); \ jx++; \ @@ -387,13 +387,13 @@ r.cidx(i+1) = jx; \ } \ \ - r.maybe_compress (); \ + r.maybe_compress (); \ } \ \ return r; \ } -#define SPARSE_A2A2_FCN_1(FCN, OP) \ +#define SPARSE_A2A2_FCN_1(FCN, OP) \ template <class T> \ MSparse<T> \ FCN (const MSparse<T>& a, const MSparse<T>& b) \ @@ -412,7 +412,7 @@ r = MSparse<T> (b_nr, b_nc); \ else \ { \ - r = MSparse<T> (b); \ + r = MSparse<T> (b); \ octave_idx_type b_nnz = b.nnz(); \ \ for (octave_idx_type i = 0 ; i < b_nnz ; i++) \ @@ -429,7 +429,7 @@ r = MSparse<T> (a_nr, a_nc); \ else \ { \ - r = MSparse<T> (a); \ + r = MSparse<T> (a); \ octave_idx_type a_nnz = a.nnz(); \ \ for (octave_idx_type i = 0 ; i < a_nnz ; i++) \ @@ -447,7 +447,7 @@ r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); \ \ octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ + r.cidx (0) = 0; \ for (octave_idx_type i = 0 ; i < a_nc ; i++) \ { \ octave_idx_type ja = a.cidx(i); \ @@ -473,8 +473,8 @@ } \ else \ { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ + if ((a.data(ja) OP b.data(jb)) != 0.) \ + { \ r.data(jx) = a.data(ja) OP b.data(jb); \ r.ridx(jx) = a.ridx(ja); \ jx++; \ @@ -486,13 +486,13 @@ r.cidx(i+1) = jx; \ } \ \ - r.maybe_compress (); \ + r.maybe_compress (); \ } \ \ return r; \ } -#define SPARSE_A2A2_FCN_2(FCN, OP) \ +#define SPARSE_A2A2_FCN_2(FCN, OP) \ template <class T> \ MSparse<T> \ FCN (const MSparse<T>& a, const MSparse<T>& b) \ @@ -529,7 +529,7 @@ { \ octave_quit (); \ r.data(idxj + b.ridx(i)) = val OP b.data(i); \ - } \ + } \ } \ r.maybe_compress (); \ } \ @@ -557,7 +557,7 @@ { \ octave_quit (); \ r.data(idxj + a.ridx(i)) = a.data(i) OP val; \ - } \ + } \ } \ r.maybe_compress (); \ } \ @@ -584,13 +584,13 @@ if ((! jb_lt_max) || \ (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ { \ - r.elem (a.ridx(ja),i) = a.data(ja) OP Zero; \ + r.elem (a.ridx(ja),i) = a.data(ja) OP Zero; \ ja++; ja_lt_max= ja < ja_max; \ } \ else if (( !ja_lt_max ) || \ (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ { \ - r.elem (b.ridx(jb),i) = Zero OP b.data(jb); \ + r.elem (b.ridx(jb),i) = Zero OP b.data(jb); \ jb++; jb_lt_max= jb < jb_max; \ } \ else \ @@ -602,7 +602,7 @@ } \ } \ \ - r.maybe_compress (true); \ + r.maybe_compress (true); \ } \ \ return r; \
--- a/liboctave/MatrixType.cc +++ b/liboctave/MatrixType.cc @@ -52,7 +52,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = a.perm[i]; + perm[i] = a.perm[i]; } } @@ -77,7 +77,7 @@ for (octave_idx_type j = 0; j < ncols && upper; j++) - { + { T d = a.elem (j,j); upper = upper && (d != zero); lower = lower && (d != zero); @@ -87,7 +87,7 @@ for (octave_idx_type j = 0; j < ncols && (upper || lower || hermitian); j++) - { + { for (octave_idx_type i = 0; i < j; i++) { double aij = a.elem (i,j), aji = a.elem (j,i); @@ -96,16 +96,16 @@ hermitian = hermitian && (aij == aji && aij*aij < diag(i)*diag(j)); } - } + } if (upper) - typ = MatrixType::Upper; + typ = MatrixType::Upper; else if (lower) - typ = MatrixType::Lower; + typ = MatrixType::Lower; else if (hermitian) - typ = MatrixType::Hermitian; + typ = MatrixType::Hermitian; else - typ = MatrixType::Full; + typ = MatrixType::Full; } else typ = MatrixType::Rectangular; @@ -134,7 +134,7 @@ for (octave_idx_type j = 0; j < ncols && upper; j++) - { + { T d = a.elem (j,j); upper = upper && (d != zero); lower = lower && (d != zero); @@ -144,7 +144,7 @@ for (octave_idx_type j = 0; j < ncols && (upper || lower || hermitian); j++) - { + { for (octave_idx_type i = 0; i < j; i++) { T aij = a.elem (i,j), aji = a.elem (j,i); @@ -153,17 +153,17 @@ hermitian = hermitian && (aij == std::conj (aji) && std::norm (aij) < diag(i)*diag(j)); } - } + } if (upper) - typ = MatrixType::Upper; + typ = MatrixType::Upper; else if (lower) - typ = MatrixType::Lower; + typ = MatrixType::Lower; else if (hermitian) - typ = MatrixType::Hermitian; + typ = MatrixType::Hermitian; else if (ncols == nrows) - typ = MatrixType::Full; + typ = MatrixType::Full; } else typ = MatrixType::Rectangular; @@ -228,39 +228,39 @@ octave_idx_type i; // Maybe the matrix is diagonal for (i = 0; i < nm; i++) - { - if (a.cidx(i+1) != a.cidx(i) + 1) - { - tmp_typ = MatrixType::Full; - break; - } - if (a.ridx(i) != i) - { - tmp_typ = MatrixType::Permuted_Diagonal; - break; - } - } - + { + if (a.cidx(i+1) != a.cidx(i) + 1) + { + tmp_typ = MatrixType::Full; + break; + } + if (a.ridx(i) != i) + { + tmp_typ = MatrixType::Permuted_Diagonal; + break; + } + } + if (tmp_typ == MatrixType::Permuted_Diagonal) - { - std::vector<bool> found (nrows); + { + std::vector<bool> found (nrows); - for (octave_idx_type j = 0; j < i; j++) - found [j] = true; - for (octave_idx_type j = i; j < nrows; j++) - found [j] = false; - - for (octave_idx_type j = i; j < nm; j++) - { - if ((a.cidx(j+1) > a.cidx(j) + 1) || - ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) - { - tmp_typ = MatrixType::Full; - break; - } - found [a.ridx(j)] = true; - } - } + for (octave_idx_type j = 0; j < i; j++) + found [j] = true; + for (octave_idx_type j = i; j < nrows; j++) + found [j] = false; + + for (octave_idx_type j = i; j < nm; j++) + { + if ((a.cidx(j+1) > a.cidx(j) + 1) || + ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) + { + tmp_typ = MatrixType::Full; + break; + } + found [a.ridx(j)] = true; + } + } typ = tmp_typ; } @@ -271,209 +271,209 @@ upper_band = 0; lower_band = 0; for (octave_idx_type j = 0; j < ncols; j++) - { - bool zero_on_diagonal = false; - if (j < nrows) - { - zero_on_diagonal = true; - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - if (a.ridx(i) == j) - { - zero_on_diagonal = false; - break; - } - } + { + bool zero_on_diagonal = false; + if (j < nrows) + { + zero_on_diagonal = true; + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + if (a.ridx(i) == j) + { + zero_on_diagonal = false; + break; + } + } - if (zero_on_diagonal) - { - singular = true; - break; - } + if (zero_on_diagonal) + { + singular = true; + break; + } - if (a.cidx(j+1) != a.cidx(j)) - { - octave_idx_type ru = a.ridx(a.cidx(j)); - octave_idx_type rl = a.ridx(a.cidx(j+1)-1); + if (a.cidx(j+1) != a.cidx(j)) + { + octave_idx_type ru = a.ridx(a.cidx(j)); + octave_idx_type rl = a.ridx(a.cidx(j+1)-1); - if (j - ru > upper_band) - upper_band = j - ru; - - if (rl - j > lower_band) - lower_band = rl - j; - } - } + if (j - ru > upper_band) + upper_band = j - ru; + + if (rl - j > lower_band) + lower_band = rl - j; + } + } if (!singular) - { - bandden = double (nnz) / - (double (ncols) * (double (lower_band) + - double (upper_band)) - - 0.5 * double (upper_band + 1) * double (upper_band) - - 0.5 * double (lower_band + 1) * double (lower_band)); + { + bandden = double (nnz) / + (double (ncols) * (double (lower_band) + + double (upper_band)) - + 0.5 * double (upper_band + 1) * double (upper_band) - + 0.5 * double (lower_band + 1) * double (lower_band)); - if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) - { - if (upper_band == 1 && lower_band == 1) - typ = MatrixType::Tridiagonal; - else - typ = MatrixType::Banded; + if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) + { + if (upper_band == 1 && lower_band == 1) + typ = MatrixType::Tridiagonal; + else + typ = MatrixType::Banded; - octave_idx_type nnz_in_band = - (upper_band + lower_band + 1) * nrows - - (1 + upper_band) * upper_band / 2 - - (1 + lower_band) * lower_band / 2; - if (nnz_in_band == nnz) - dense = true; - else - dense = false; - } - else if (upper_band == 0) - typ = MatrixType::Lower; - else if (lower_band == 0) - typ = MatrixType::Upper; + octave_idx_type nnz_in_band = + (upper_band + lower_band + 1) * nrows - + (1 + upper_band) * upper_band / 2 - + (1 + lower_band) * lower_band / 2; + if (nnz_in_band == nnz) + dense = true; + else + dense = false; + } + else if (upper_band == 0) + typ = MatrixType::Lower; + else if (lower_band == 0) + typ = MatrixType::Upper; - if (upper_band == lower_band && nrows == ncols) - maybe_hermitian = true; - } + if (upper_band == lower_band && nrows == ncols) + maybe_hermitian = true; + } if (typ == MatrixType::Full) - { - // Search for a permuted triangular matrix, and test if - // permutation is singular + { + // Search for a permuted triangular matrix, and test if + // permutation is singular - // FIXME - // Perhaps this should be based on a dmperm algorithm - bool found = false; + // FIXME + // Perhaps this should be based on a dmperm algorithm + bool found = false; - nperm = ncols; - perm = new octave_idx_type [ncols]; + nperm = ncols; + 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 < ncols; i++) + perm [i] = -1; - for (octave_idx_type i = 0; i < nm; i++) - { - found = false; + for (octave_idx_type i = 0; i < nm; i++) + { + found = false; - 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)) - { - perm [i] = j; - found = true; - break; - } - } + 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)) + { + perm [i] = j; + found = true; + break; + } + } - if (!found) - break; - } + if (!found) + break; + } - if (found) - { - typ = MatrixType::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; - delete [] perm; - perm = new octave_idx_type [nrows]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); + if (found) + { + typ = MatrixType::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; + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - for (octave_idx_type i = 0; i < nrows; i++) - { - perm [i] = -1; - tmp [i] = -1; - } + for (octave_idx_type i = 0; i < nrows; i++) + { + perm [i] = -1; + tmp [i] = -1; + } - 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; + 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; - found = true; - for (octave_idx_type i = 0; i < nm; i++) - if (perm[i] == -1) - { - found = false; - break; - } - else - { - tmp[perm[i]] = 1; - } + found = true; + for (octave_idx_type i = 0; i < nm; i++) + if (perm[i] == -1) + { + found = false; + break; + } + else + { + tmp[perm[i]] = 1; + } - if (found) - { - octave_idx_type k = ncols; - for (octave_idx_type i = 0; i < nrows; i++) - { - if (tmp[i] == -1) - { - if (k < nrows) - { - perm[k++] = i; - } - else - { - found = false; - break; - } - } - } - } + if (found) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) + { + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } + } + } - if (found) - typ = MatrixType::Permuted_Lower; - else - { - delete [] perm; - nperm = 0; - } - } - else - { - delete [] perm; - nperm = 0; - } - } + if (found) + typ = MatrixType::Permuted_Lower; + else + { + delete [] perm; + nperm = 0; + } + } + else + { + delete [] perm; + nperm = 0; + } + } // FIXME // 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 == MatrixType::Lower || typ == MatrixType::Permuted_Lower) - && nrows > ncols) || - ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) - && nrows < ncols)) - { - typ = MatrixType::Rectangular; - if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Permuted_Lower) - delete [] perm; - nperm = 0; - } + && nrows > ncols) || + ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + && nrows < ncols)) + { + typ = MatrixType::Rectangular; + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Permuted_Lower) + delete [] perm; + nperm = 0; + } if (typ == MatrixType::Full && ncols != nrows) - typ = MatrixType::Rectangular; + typ = MatrixType::Rectangular; if (maybe_hermitian && (typ == MatrixType::Full || - typ == MatrixType::Tridiagonal || - typ == MatrixType::Banded)) - { - bool is_herm = true; + typ == MatrixType::Tridiagonal || + typ == MatrixType::Banded)) + { + bool is_herm = true; // first, check whether the diagonal is positive & extract it ColumnVector diag (ncols); - for (octave_idx_type j = 0; is_herm && j < ncols; j++) + for (octave_idx_type j = 0; is_herm && j < ncols; j++) { is_herm = false; for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) @@ -512,16 +512,16 @@ } } - if (is_herm) - { - if (typ == MatrixType::Full) - typ = MatrixType::Hermitian; - else if (typ == MatrixType::Banded) - typ = MatrixType::Banded_Hermitian; - else - typ = MatrixType::Tridiagonal_Hermitian; - } - } + if (is_herm) + { + if (typ == MatrixType::Full) + typ = MatrixType::Hermitian; + else if (typ == MatrixType::Banded) + typ = MatrixType::Banded_Hermitian; + else + typ = MatrixType::Tridiagonal_Hermitian; + } + } } } @@ -549,39 +549,39 @@ octave_idx_type i; // Maybe the matrix is diagonal for (i = 0; i < nm; i++) - { - if (a.cidx(i+1) != a.cidx(i) + 1) - { - tmp_typ = MatrixType::Full; - break; - } - if (a.ridx(i) != i) - { - tmp_typ = MatrixType::Permuted_Diagonal; - break; - } - } - + { + if (a.cidx(i+1) != a.cidx(i) + 1) + { + tmp_typ = MatrixType::Full; + break; + } + if (a.ridx(i) != i) + { + tmp_typ = MatrixType::Permuted_Diagonal; + break; + } + } + if (tmp_typ == MatrixType::Permuted_Diagonal) - { - std::vector<bool> found (nrows); + { + std::vector<bool> found (nrows); - for (octave_idx_type j = 0; j < i; j++) - found [j] = true; - for (octave_idx_type j = i; j < nrows; j++) - found [j] = false; - - for (octave_idx_type j = i; j < nm; j++) - { - if ((a.cidx(j+1) > a.cidx(j) + 1) || - ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) - { - tmp_typ = MatrixType::Full; - break; - } - found [a.ridx(j)] = true; - } - } + for (octave_idx_type j = 0; j < i; j++) + found [j] = true; + for (octave_idx_type j = i; j < nrows; j++) + found [j] = false; + + for (octave_idx_type j = i; j < nm; j++) + { + if ((a.cidx(j+1) > a.cidx(j) + 1) || + ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) + { + tmp_typ = MatrixType::Full; + break; + } + found [a.ridx(j)] = true; + } + } typ = tmp_typ; } @@ -592,209 +592,209 @@ upper_band = 0; lower_band = 0; for (octave_idx_type j = 0; j < ncols; j++) - { - bool zero_on_diagonal = false; - if (j < nrows) - { - zero_on_diagonal = true; - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - if (a.ridx(i) == j) - { - zero_on_diagonal = false; - break; - } - } + { + bool zero_on_diagonal = false; + if (j < nrows) + { + zero_on_diagonal = true; + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + if (a.ridx(i) == j) + { + zero_on_diagonal = false; + break; + } + } - if (zero_on_diagonal) - { - singular = true; - break; - } + if (zero_on_diagonal) + { + singular = true; + break; + } - if (a.cidx(j+1) != a.cidx(j)) - { - octave_idx_type ru = a.ridx(a.cidx(j)); - octave_idx_type rl = a.ridx(a.cidx(j+1)-1); + if (a.cidx(j+1) != a.cidx(j)) + { + octave_idx_type ru = a.ridx(a.cidx(j)); + octave_idx_type rl = a.ridx(a.cidx(j+1)-1); - if (j - ru > upper_band) - upper_band = j - ru; - - if (rl - j > lower_band) - lower_band = rl - j; - } - } + if (j - ru > upper_band) + upper_band = j - ru; + + if (rl - j > lower_band) + lower_band = rl - j; + } + } if (!singular) - { - bandden = double (nnz) / - (double (ncols) * (double (lower_band) + - double (upper_band)) - - 0.5 * double (upper_band + 1) * double (upper_band) - - 0.5 * double (lower_band + 1) * double (lower_band)); + { + bandden = double (nnz) / + (double (ncols) * (double (lower_band) + + double (upper_band)) - + 0.5 * double (upper_band + 1) * double (upper_band) - + 0.5 * double (lower_band + 1) * double (lower_band)); - if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) - { - if (upper_band == 1 && lower_band == 1) - typ = MatrixType::Tridiagonal; - else - typ = MatrixType::Banded; + if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) + { + if (upper_band == 1 && lower_band == 1) + typ = MatrixType::Tridiagonal; + else + typ = MatrixType::Banded; - octave_idx_type nnz_in_band = - (upper_band + lower_band + 1) * nrows - - (1 + upper_band) * upper_band / 2 - - (1 + lower_band) * lower_band / 2; - if (nnz_in_band == nnz) - dense = true; - else - dense = false; - } - else if (upper_band == 0) - typ = MatrixType::Lower; - else if (lower_band == 0) - typ = MatrixType::Upper; + octave_idx_type nnz_in_band = + (upper_band + lower_band + 1) * nrows - + (1 + upper_band) * upper_band / 2 - + (1 + lower_band) * lower_band / 2; + if (nnz_in_band == nnz) + dense = true; + else + dense = false; + } + else if (upper_band == 0) + typ = MatrixType::Lower; + else if (lower_band == 0) + typ = MatrixType::Upper; - if (upper_band == lower_band && nrows == ncols) - maybe_hermitian = true; - } + if (upper_band == lower_band && nrows == ncols) + maybe_hermitian = true; + } if (typ == MatrixType::Full) - { - // Search for a permuted triangular matrix, and test if - // permutation is singular + { + // Search for a permuted triangular matrix, and test if + // permutation is singular - // FIXME - // Perhaps this should be based on a dmperm algorithm - bool found = false; + // FIXME + // Perhaps this should be based on a dmperm algorithm + bool found = false; - nperm = ncols; - perm = new octave_idx_type [ncols]; + nperm = ncols; + 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 < ncols; i++) + perm [i] = -1; - for (octave_idx_type i = 0; i < nm; i++) - { - found = false; + for (octave_idx_type i = 0; i < nm; i++) + { + found = false; - 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)) - { - perm [i] = j; - found = true; - break; - } - } + 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)) + { + perm [i] = j; + found = true; + break; + } + } - if (!found) - break; - } + if (!found) + break; + } - if (found) - { - typ = MatrixType::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; - delete [] perm; - perm = new octave_idx_type [nrows]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); + if (found) + { + typ = MatrixType::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; + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - for (octave_idx_type i = 0; i < nrows; i++) - { - perm [i] = -1; - tmp [i] = -1; - } + for (octave_idx_type i = 0; i < nrows; i++) + { + perm [i] = -1; + tmp [i] = -1; + } - 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; + 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; - found = true; - for (octave_idx_type i = 0; i < nm; i++) - if (perm[i] == -1) - { - found = false; - break; - } - else - { - tmp[perm[i]] = 1; - } + found = true; + for (octave_idx_type i = 0; i < nm; i++) + if (perm[i] == -1) + { + found = false; + break; + } + else + { + tmp[perm[i]] = 1; + } - if (found) - { - octave_idx_type k = ncols; - for (octave_idx_type i = 0; i < nrows; i++) - { - if (tmp[i] == -1) - { - if (k < nrows) - { - perm[k++] = i; - } - else - { - found = false; - break; - } - } - } - } + if (found) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) + { + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } + } + } - if (found) - typ = MatrixType::Permuted_Lower; - else - { - delete [] perm; - nperm = 0; - } - } - else - { - delete [] perm; - nperm = 0; - } - } + if (found) + typ = MatrixType::Permuted_Lower; + else + { + delete [] perm; + nperm = 0; + } + } + else + { + delete [] perm; + nperm = 0; + } + } // FIXME // 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 == MatrixType::Lower || typ == MatrixType::Permuted_Lower) - && nrows > ncols) || - ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) - && nrows < ncols)) - { - typ = MatrixType::Rectangular; - if (typ == MatrixType::Permuted_Upper || - typ == MatrixType::Permuted_Lower) - delete [] perm; - nperm = 0; - } + && nrows > ncols) || + ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + && nrows < ncols)) + { + typ = MatrixType::Rectangular; + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Permuted_Lower) + delete [] perm; + nperm = 0; + } if (typ == MatrixType::Full && ncols != nrows) - typ = MatrixType::Rectangular; + typ = MatrixType::Rectangular; if (maybe_hermitian && (typ == MatrixType::Full || - typ == MatrixType::Tridiagonal || - typ == MatrixType::Banded)) - { - bool is_herm = true; + typ == MatrixType::Tridiagonal || + typ == MatrixType::Banded)) + { + bool is_herm = true; // first, check whether the diagonal is positive & extract it ColumnVector diag (ncols); - for (octave_idx_type j = 0; is_herm && j < ncols; j++) + for (octave_idx_type j = 0; is_herm && j < ncols; j++) { is_herm = false; for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) @@ -834,16 +834,16 @@ } - if (is_herm) - { - if (typ == MatrixType::Full) - typ = MatrixType::Hermitian; - else if (typ == MatrixType::Banded) - typ = MatrixType::Banded_Hermitian; - else - typ = MatrixType::Tridiagonal_Hermitian; - } - } + if (is_herm) + { + if (typ == MatrixType::Full) + typ = MatrixType::Hermitian; + else if (typ == MatrixType::Banded) + typ = MatrixType::Banded_Hermitian; + else + typ = MatrixType::Tridiagonal_Hermitian; + } + } } } MatrixType::MatrixType (const matrix_type t, bool _full) @@ -863,7 +863,7 @@ } MatrixType::MatrixType (const matrix_type t, const octave_idx_type np, - const octave_idx_type *p, bool _full) + const octave_idx_type *p, bool _full) : typ (MatrixType::Unknown), sp_bandden (octave_sparse_params::get_bandden()), bandden (0), upper_band (0), lower_band (0), @@ -876,14 +876,14 @@ nperm = np; perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = p[i]; + perm[i] = p[i]; } else (*current_liboctave_warning_handler) ("Invalid matrix type"); } MatrixType::MatrixType (const matrix_type t, const octave_idx_type ku, - const octave_idx_type kl, bool _full) + const octave_idx_type kl, bool _full) : typ (MatrixType::Unknown), sp_bandden (octave_sparse_params::get_bandden()), bandden (0), upper_band (0), lower_band (0), @@ -922,11 +922,11 @@ nperm = a.nperm; if (nperm != 0) - { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = a.perm[i]; - } + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = a.perm[i]; + } } return *this; @@ -939,9 +939,9 @@ sp_bandden == octave_sparse_params::get_bandden())) { if (!quiet && - octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + octave_sparse_params::get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -963,8 +963,8 @@ sp_bandden == octave_sparse_params::get_bandden())) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -983,7 +983,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -996,8 +996,8 @@ sp_bandden == octave_sparse_params::get_bandden())) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -1016,7 +1016,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -1028,8 +1028,8 @@ if (typ != MatrixType::Unknown) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -1043,7 +1043,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -1055,8 +1055,8 @@ if (typ != MatrixType::Unknown) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -1070,7 +1070,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -1082,8 +1082,8 @@ if (typ != MatrixType::Unknown) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -1097,7 +1097,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -1109,8 +1109,8 @@ if (typ != MatrixType::Unknown) { if (octave_sparse_params::get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Matrix Type"); + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); return typ; } @@ -1124,7 +1124,7 @@ { perm = new octave_idx_type [nperm]; for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; + perm[i] = tmp_typ.perm[i]; } return typ; @@ -1136,49 +1136,49 @@ if (octave_sparse_params::get_key ("spumoni") != 0.) { if (typ == MatrixType::Unknown) - (*current_liboctave_warning_handler) - ("Unknown Matrix Type"); + (*current_liboctave_warning_handler) + ("Unknown Matrix Type"); else if (typ == MatrixType::Diagonal) - (*current_liboctave_warning_handler) - ("Diagonal Sparse Matrix"); + (*current_liboctave_warning_handler) + ("Diagonal Sparse Matrix"); else if (typ == MatrixType::Permuted_Diagonal) - (*current_liboctave_warning_handler) - ("Permuted Diagonal Sparse Matrix"); + (*current_liboctave_warning_handler) + ("Permuted Diagonal Sparse Matrix"); else if (typ == MatrixType::Upper) - (*current_liboctave_warning_handler) - ("Upper Triangular Matrix"); + (*current_liboctave_warning_handler) + ("Upper Triangular Matrix"); else if (typ == MatrixType::Lower) - (*current_liboctave_warning_handler) - ("Lower Triangular Matrix"); + (*current_liboctave_warning_handler) + ("Lower Triangular Matrix"); else if (typ == MatrixType::Permuted_Upper) - (*current_liboctave_warning_handler) - ("Permuted Upper Triangular Matrix"); + (*current_liboctave_warning_handler) + ("Permuted Upper Triangular Matrix"); else if (typ == MatrixType::Permuted_Lower) - (*current_liboctave_warning_handler) - ("Permuted Lower Triangular Matrix"); + (*current_liboctave_warning_handler) + ("Permuted Lower Triangular Matrix"); else if (typ == MatrixType::Banded) - (*current_liboctave_warning_handler) - ("Banded Sparse Matrix %d-1-%d (Density %f)", lower_band, - upper_band, bandden); + (*current_liboctave_warning_handler) + ("Banded Sparse Matrix %d-1-%d (Density %f)", lower_band, + upper_band, bandden); else if (typ == MatrixType::Banded_Hermitian) - (*current_liboctave_warning_handler) - ("Banded Hermitian/Symmetric Sparse Matrix %d-1-%d (Density %f)", - lower_band, upper_band, bandden); + (*current_liboctave_warning_handler) + ("Banded Hermitian/Symmetric Sparse Matrix %d-1-%d (Density %f)", + lower_band, upper_band, bandden); else if (typ == MatrixType::Hermitian) - (*current_liboctave_warning_handler) - ("Hermitian/Symmetric Matrix"); + (*current_liboctave_warning_handler) + ("Hermitian/Symmetric Matrix"); else if (typ == MatrixType::Tridiagonal) - (*current_liboctave_warning_handler) - ("Tridiagonal Sparse Matrix"); + (*current_liboctave_warning_handler) + ("Tridiagonal Sparse Matrix"); else if (typ == MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_warning_handler) - ("Hermitian/Symmetric Tridiagonal Sparse Matrix"); + (*current_liboctave_warning_handler) + ("Hermitian/Symmetric Tridiagonal Sparse Matrix"); else if (typ == MatrixType::Rectangular) - (*current_liboctave_warning_handler) - ("Rectangular/Singular Matrix"); + (*current_liboctave_warning_handler) + ("Rectangular/Singular Matrix"); else if (typ == MatrixType::Full) - (*current_liboctave_warning_handler) - ("Full Matrix"); + (*current_liboctave_warning_handler) + ("Full Matrix"); } } @@ -1189,10 +1189,10 @@ typ == MatrixType::Tridiagonal_Hermitian) typ = MatrixType::Tridiagonal_Hermitian; else if (typ == MatrixType::Banded || - typ == MatrixType::Banded_Hermitian) + typ == MatrixType::Banded_Hermitian) typ = MatrixType::Banded_Hermitian; else if (typ == MatrixType::Full || typ == MatrixType::Hermitian || - typ == MatrixType::Unknown) + typ == MatrixType::Unknown) typ = MatrixType::Hermitian; else (*current_liboctave_error_handler) @@ -1206,10 +1206,10 @@ typ == MatrixType::Tridiagonal_Hermitian) typ = MatrixType::Tridiagonal; else if (typ == MatrixType::Banded || - typ == MatrixType::Banded_Hermitian) + typ == MatrixType::Banded_Hermitian) typ = MatrixType::Banded; else if (typ == MatrixType::Full || typ == MatrixType::Hermitian || - typ == MatrixType::Unknown) + typ == MatrixType::Unknown) typ = MatrixType::Full; }
--- a/liboctave/ODES.cc +++ b/liboctave/ODES.cc @@ -36,7 +36,7 @@ void ODES::initialize (const ColumnVector& xx, double tt, - const ColumnVector& xtheta) + const ColumnVector& xtheta) { base_diff_eqn::initialize (xx, tt); xdot = ColumnVector (xx.length (), 0.0);
--- a/liboctave/Quad.cc +++ b/liboctave/Quad.cc @@ -42,34 +42,34 @@ typedef octave_idx_type (*quad_fcn_ptr) (double*, int&, double*); typedef octave_idx_type (*quad_float_fcn_ptr) (float*, int&, float*); - + extern "C" { F77_RET_T F77_FUNC (dqagp, DQAGP) (quad_fcn_ptr, const double&, const double&, - const octave_idx_type&, const double*, const double&, - const double&, double&, double&, octave_idx_type&, - octave_idx_type&, const octave_idx_type&, const octave_idx_type&, octave_idx_type&, octave_idx_type*, - double*); + const octave_idx_type&, const double*, const double&, + const double&, double&, double&, octave_idx_type&, + octave_idx_type&, const octave_idx_type&, const octave_idx_type&, octave_idx_type&, octave_idx_type*, + double*); F77_RET_T F77_FUNC (dqagi, DQAGI) (quad_fcn_ptr, const double&, const octave_idx_type&, - const double&, const double&, double&, - double&, octave_idx_type&, octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, octave_idx_type&, octave_idx_type*, double*); + const double&, const double&, double&, + double&, octave_idx_type&, octave_idx_type&, const octave_idx_type&, + const octave_idx_type&, octave_idx_type&, octave_idx_type*, double*); F77_RET_T F77_FUNC (qagp, QAGP) (quad_float_fcn_ptr, const float&, const float&, - const octave_idx_type&, const float*, const float&, - const float&, float&, float&, octave_idx_type&, - octave_idx_type&, const octave_idx_type&, const octave_idx_type&, octave_idx_type&, octave_idx_type*, - float*); + const octave_idx_type&, const float*, const float&, + const float&, float&, float&, octave_idx_type&, + octave_idx_type&, const octave_idx_type&, const octave_idx_type&, octave_idx_type&, octave_idx_type*, + float*); F77_RET_T F77_FUNC (qagi, QAGI) (quad_float_fcn_ptr, const float&, const octave_idx_type&, - const float&, const float&, float&, - float&, octave_idx_type&, octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, octave_idx_type&, octave_idx_type*, float*); + const float&, const float&, float&, + float&, octave_idx_type&, octave_idx_type&, const octave_idx_type&, + const octave_idx_type&, octave_idx_type&, octave_idx_type*, float*); } static octave_idx_type @@ -140,9 +140,9 @@ double rel_tol = relative_tolerance (); F77_XFCN (dqagp, DQAGP, (user_function, lower_limit, upper_limit, - npts, points, abs_tol, rel_tol, result, - abserr, neval, ier, leniw, lenw, last, - piwork, pwork)); + npts, points, abs_tol, rel_tol, result, + abserr, neval, ier, leniw, lenw, last, + piwork, pwork)); return result; } @@ -194,8 +194,8 @@ double rel_tol = relative_tolerance (); F77_XFCN (dqagi, DQAGI, (user_function, bound, inf, abs_tol, rel_tol, - result, abserr, neval, ier, leniw, lenw, - last, piwork, pwork)); + result, abserr, neval, ier, leniw, lenw, + last, piwork, pwork)); return result; } @@ -236,9 +236,9 @@ float rel_tol = single_precision_relative_tolerance (); F77_XFCN (qagp, QAGP, (float_user_function, lower_limit, upper_limit, - npts, points, abs_tol, rel_tol, result, - abserr, neval, ier, leniw, lenw, last, - piwork, pwork)); + npts, points, abs_tol, rel_tol, result, + abserr, neval, ier, leniw, lenw, last, + piwork, pwork)); return result; } @@ -290,8 +290,8 @@ float rel_tol = single_precision_relative_tolerance (); F77_XFCN (qagi, QAGI, (float_user_function, bound, inf, abs_tol, rel_tol, - result, abserr, neval, ier, leniw, lenw, - last, piwork, pwork)); + result, abserr, neval, ier, leniw, lenw, + last, piwork, pwork)); return result; }
--- a/liboctave/Range.cc +++ b/liboctave/Range.cc @@ -52,8 +52,8 @@ // or fewer elements only the base needs to be an integer return (! (xisnan (rng_base) || xisnan (rng_inc)) - && (NINTbig (rng_base) == rng_base || rng_nelem < 1) - && (NINTbig (rng_inc) == rng_inc || rng_nelem <= 1)); + && (NINTbig (rng_base) == rng_base || rng_nelem < 1) + && (NINTbig (rng_inc) == rng_inc || rng_nelem <= 1)); } Matrix @@ -65,7 +65,7 @@ double b = rng_base; double increment = rng_inc; for (octave_idx_type i = 0; i < rng_nelem; i++) - cache(i) = b + i * increment; + cache(i) = b + i * increment; // On some machines (x86 with extended precision floating point // arithmetic, for example) it is possible that we can overshoot @@ -74,8 +74,8 @@ // elements. if ((rng_inc > 0 && cache(rng_nelem-1) > rng_limit) - || (rng_inc < 0 && cache(rng_nelem-1) < rng_limit)) - cache(rng_nelem-1) = rng_limit; + || (rng_inc < 0 && cache(rng_nelem-1) < rng_limit)) + cache(rng_nelem-1) = rng_limit; } return cache; @@ -142,16 +142,16 @@ if (rng_nelem > 0) { if (rng_inc > 0) - retval = rng_base; + retval = rng_base; else - { - retval = rng_base + (rng_nelem - 1) * rng_inc; + { + retval = rng_base + (rng_nelem - 1) * rng_inc; - // See the note in the matrix_value method above. + // See the note in the matrix_value method above. - if (retval < rng_limit) - retval = rng_limit; - } + if (retval < rng_limit) + retval = rng_limit; + } } return retval; @@ -164,16 +164,16 @@ if (rng_nelem > 0) { if (rng_inc > 0) - { - retval = rng_base + (rng_nelem - 1) * rng_inc; + { + retval = rng_base + (rng_nelem - 1) * rng_inc; - // See the note in the matrix_value method above. + // See the note in the matrix_value method above. - if (retval > rng_limit) - retval = rng_limit; - } + if (retval > rng_limit) + retval = rng_limit; + } else - retval = rng_base; + retval = rng_base; } return retval; } @@ -251,9 +251,9 @@ if (dim == 1) { if (mode == ASCENDING) - retval.sort_internal (true); + retval.sort_internal (true); else if (mode == DESCENDING) - retval.sort_internal (false); + retval.sort_internal (false); } else if (dim != 0) (*current_liboctave_error_handler) ("Range::sort: invalid dimension"); @@ -263,16 +263,16 @@ Range Range::sort (Array<octave_idx_type>& sidx, octave_idx_type dim, - sortmode mode) const + sortmode mode) const { Range retval = *this; if (dim == 1) { if (mode == ASCENDING) - retval.sort_internal (sidx, true); + retval.sort_internal (sidx, true); else if (mode == DESCENDING) - retval.sort_internal (sidx, false); + retval.sort_internal (sidx, false); } else if (dim != 0) (*current_liboctave_error_handler) ("Range::sort: invalid dimension"); @@ -319,10 +319,10 @@ { is >> a.rng_limit; if (is) - { - is >> a.rng_inc; - a.rng_nelem = a.nelem_internal (); - } + { + is >> a.rng_inc; + a.rng_nelem = a.nelem_internal (); + } } return is; @@ -497,12 +497,12 @@ // [1.8, 1.85, 1.9]. if (! teq (rng_base + (n_elt - 1) * rng_inc, rng_limit)) - { - if (teq (rng_base + (n_elt - 2) * rng_inc, rng_limit)) - n_elt--; - else if (teq (rng_base + n_elt * rng_inc, rng_limit)) - n_elt++; - } + { + if (teq (rng_base + (n_elt - 2) * rng_inc, rng_limit)) + n_elt--; + else if (teq (rng_base + n_elt * rng_inc, rng_limit)) + n_elt++; + } retval = (n_elt >= std::numeric_limits<octave_idx_type>::max () - 1) ? -1 : n_elt; }
--- a/liboctave/Sparse-C.cc +++ b/liboctave/Sparse-C.cc @@ -46,7 +46,7 @@ sparse_ascending_compare<Complex> (const Complex& a, const Complex& b) { return (xisnan (b) || (xabs (a) < xabs (b)) - || ((xabs (a) == xabs (b)) && (arg (a) < arg (b)))); + || ((xabs (a) == xabs (b)) && (arg (a) < arg (b)))); } template <> @@ -54,7 +54,7 @@ sparse_descending_compare<Complex> (const Complex& a, const Complex& b) { return (xisnan (a) || (xabs (a) > xabs (b)) - || ((xabs (a) == xabs (b)) && (arg (a) > arg (b)))); + || ((xabs (a) == xabs (b)) && (arg (a) > arg (b)))); } INSTANTIATE_SPARSE_AND_ASSIGN (Complex, OCTAVE_API);
--- a/liboctave/Sparse.cc +++ b/liboctave/Sparse.cc @@ -55,32 +55,32 @@ if (nzmx > 0) { for (i = c[_c]; i < c[_c + 1]; i++) - if (r[i] == _r) - return d[i]; - else if (r[i] > _r) - break; + if (r[i] == _r) + return d[i]; + else if (r[i] > _r) + break; // Ok, If we've gotten here, we're in trouble.. Have to create a // new element in the sparse array. This' gonna be slow!!! if (c[ncols] == nzmx) - { - (*current_liboctave_error_handler) - ("Sparse::SparseRep::elem (octave_idx_type, octave_idx_type): sparse matrix filled"); - return *d; - } + { + (*current_liboctave_error_handler) + ("Sparse::SparseRep::elem (octave_idx_type, octave_idx_type): sparse matrix filled"); + return *d; + } octave_idx_type to_move = c[ncols] - i; if (to_move != 0) - { - for (octave_idx_type j = c[ncols]; j > i; j--) - { - d[j] = d[j-1]; - r[j] = r[j-1]; - } - } + { + for (octave_idx_type j = c[ncols]; j > i; j--) + { + d[j] = d[j-1]; + r[j] = r[j-1]; + } + } for (octave_idx_type j = _c + 1; j < ncols + 1; j++) - c[j] = c[j] + 1; + c[j] = c[j] + 1; d[i] = 0.; r[i] = _r; @@ -90,7 +90,7 @@ else { (*current_liboctave_error_handler) - ("Sparse::SparseRep::elem (octave_idx_type, octave_idx_type): sparse matrix filled"); + ("Sparse::SparseRep::elem (octave_idx_type, octave_idx_type): sparse matrix filled"); return *d; } } @@ -102,7 +102,7 @@ if (nzmx > 0) for (octave_idx_type i = c[_c]; i < c[_c + 1]; i++) if (r[i] == _r) - return d[i]; + return d[i]; return T (); } @@ -116,7 +116,7 @@ if (remove_zeros) for (octave_idx_type i = 0; i < nzmx - ndel; i++) if (d[i] == T ()) - nzero++; + nzero++; if (!ndel && !nzero) return; @@ -127,13 +127,13 @@ T *new_data = new T [new_nzmx]; for (octave_idx_type i = 0; i < new_nzmx; i++) - new_data[i] = d[i]; + new_data[i] = d[i]; delete [] d; d = new_data; octave_idx_type *new_ridx = new octave_idx_type [new_nzmx]; for (octave_idx_type i = 0; i < new_nzmx; i++) - new_ridx[i] = r[i]; + new_ridx[i] = r[i]; delete [] r; r = new_ridx; } @@ -147,16 +147,16 @@ octave_idx_type ii = 0; octave_idx_type ic = 0; for (octave_idx_type j = 0; j < ncols; j++) - { - for (octave_idx_type k = ic; k < c[j+1]; k++) - if (d[k] != T ()) - { - new_data [ii] = d[k]; - new_ridx [ii++] = r[k]; - } - ic = c[j+1]; - c[j+1] = ii; - } + { + for (octave_idx_type k = ic; k < c[j+1]; k++) + if (d[k] != T ()) + { + new_data [ii] = d[k]; + new_ridx [ii++] = r[k]; + } + ic = c[j+1]; + c[j+1] = ii; + } delete [] d; d = new_data; @@ -178,22 +178,22 @@ octave_idx_type * new_ridx = new octave_idx_type [nz]; for (octave_idx_type i = 0; i < min_nzmx; i++) - new_ridx[i] = r[i]; + new_ridx[i] = r[i]; delete [] r; r = new_ridx; T * new_data = new T [nz]; for (octave_idx_type i = 0; i < min_nzmx; i++) - new_data[i] = d[i]; + new_data[i] = d[i]; delete [] d; d = new_data; if (nz < nzmx) - for (octave_idx_type i = 0; i <= ncols; i++) - if (c[i] > nz) - c[i] = nz; + for (octave_idx_type i = 0; i <= ncols; i++) + if (c[i] > nz) + c[i] = nz; nzmx = nz; } @@ -220,12 +220,12 @@ octave_idx_type nz = a.nnz (); octave_idx_type nc = cols (); for (octave_idx_type i = 0; i < nz; i++) - { - xdata (i) = T (a.data (i)); - xridx (i) = a.ridx (i); - } + { + xdata (i) = T (a.data (i)); + xridx (i) = a.ridx (i); + } for (octave_idx_type i = 0; i < nc + 1; i++) - xcidx (i) = a.cidx (i); + xcidx (i) = a.cidx (i); } } @@ -240,20 +240,20 @@ octave_idx_type ii = 0; xcidx (0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - xdata (ii) = val; - xridx (ii++) = i; - } - xcidx (j+1) = ii; - } + { + for (octave_idx_type i = 0; i < nr; i++) + { + xdata (ii) = val; + xridx (ii++) = i; + } + xcidx (j+1) = ii; + } } else { rep = new typename Sparse<T>::SparseRep (nr, nc, 0); for (octave_idx_type j = 0; j < nc+1; j++) - xcidx(j) = 0; + xcidx(j) = 0; } } @@ -296,26 +296,26 @@ octave_idx_type kk = 0; xcidx(0) = 0; for (octave_idx_type i = 0; i < old_nc; i++) - for (octave_idx_type j = a.cidx(i); j < a.cidx(i+1); j++) - { - octave_idx_type tmp = i * old_nr + a.ridx(j); - octave_idx_type ii = tmp % new_nr; - octave_idx_type jj = (tmp - ii) / new_nr; - for (octave_idx_type k = kk; k < jj; k++) - xcidx(k+1) = j; - kk = jj; - xdata(j) = a.data(j); - xridx(j) = ii; - } + for (octave_idx_type j = a.cidx(i); j < a.cidx(i+1); j++) + { + octave_idx_type tmp = i * old_nr + a.ridx(j); + octave_idx_type ii = tmp % new_nr; + octave_idx_type jj = (tmp - ii) / new_nr; + for (octave_idx_type k = kk; k < jj; k++) + xcidx(k+1) = j; + kk = jj; + xdata(j) = a.data(j); + xridx(j) = ii; + } for (octave_idx_type k = kk; k < new_nc; k++) - xcidx(k+1) = new_nzmx; + xcidx(k+1) = new_nzmx; } } template <class T> Sparse<T>::Sparse (const Array<T>& a, const Array<octave_idx_type>& r, - const Array<octave_idx_type>& c, octave_idx_type nr, - octave_idx_type nc, bool sum_terms) + const Array<octave_idx_type>& c, octave_idx_type nr, + octave_idx_type nc, bool sum_terms) : dimensions (dim_vector (nr, nc)), idx (0), idx_count (0) { octave_idx_type a_len = a.length (); @@ -330,7 +330,7 @@ (r_len != c_len && !ri_scalar && !ci_scalar) || nr < 0 || nc < 0) { (*current_liboctave_error_handler) - ("Sparse::Sparse (const Array<T>&, const Array<octave_idx_type>&, ...): dimension mismatch"); + ("Sparse::Sparse (const Array<T>&, const Array<octave_idx_type>&, ...): dimension mismatch"); rep = nil_rep (); dimensions = dim_vector (0, 0); } @@ -342,97 +342,97 @@ OCTAVE_LOCAL_BUFFER (octave_sparse_sort_idxl, sidxX, max_nzmx); for (octave_idx_type i = 0; i < max_nzmx; i++) - sidx[i] = &sidxX[i]; + sidx[i] = &sidxX[i]; octave_idx_type actual_nzmx = 0; octave_quit (); for (octave_idx_type i = 0; i < max_nzmx; i++) - { - octave_idx_type rowidx = (ri_scalar ? r(0) : r(i)); - octave_idx_type colidx = (ci_scalar ? c(0) : c(i)); - if (rowidx < nr && rowidx >= 0 && - colidx < nc && colidx >= 0 ) - { - if ( a (cf_scalar ? 0 : i ) != T ()) - { - sidx[actual_nzmx]->r = rowidx; - sidx[actual_nzmx]->c = colidx; - sidx[actual_nzmx]->idx = i; - actual_nzmx++; - } - } - else - { - (*current_liboctave_error_handler) - ("Sparse::Sparse : index (%d,%d) out of range", - rowidx + 1, colidx + 1); - rep = nil_rep (); - dimensions = dim_vector (0, 0); - return; - } - } + { + octave_idx_type rowidx = (ri_scalar ? r(0) : r(i)); + octave_idx_type colidx = (ci_scalar ? c(0) : c(i)); + if (rowidx < nr && rowidx >= 0 && + colidx < nc && colidx >= 0 ) + { + if ( a (cf_scalar ? 0 : i ) != T ()) + { + sidx[actual_nzmx]->r = rowidx; + sidx[actual_nzmx]->c = colidx; + sidx[actual_nzmx]->idx = i; + actual_nzmx++; + } + } + else + { + (*current_liboctave_error_handler) + ("Sparse::Sparse : index (%d,%d) out of range", + rowidx + 1, colidx + 1); + rep = nil_rep (); + dimensions = dim_vector (0, 0); + return; + } + } if (actual_nzmx == 0) - rep = new typename Sparse<T>::SparseRep (nr, nc); + rep = new typename Sparse<T>::SparseRep (nr, nc); else - { - octave_quit (); - octave_sort<octave_sparse_sort_idxl *> - lsort (octave_sparse_sidxl_comp); - - lsort.sort (sidx, actual_nzmx); - octave_quit (); - - // Now count the unique non-zero values - octave_idx_type real_nzmx = 1; - for (octave_idx_type i = 1; i < actual_nzmx; i++) - if (sidx[i-1]->r != sidx[i]->r || sidx[i-1]->c != sidx[i]->c) - real_nzmx++; - - rep = new typename Sparse<T>::SparseRep (nr, nc, real_nzmx); - - octave_idx_type cx = 0; - octave_idx_type prev_rval = -1; - octave_idx_type prev_cval = -1; - octave_idx_type ii = -1; - xcidx (0) = 0; - for (octave_idx_type i = 0; i < actual_nzmx; i++) - { - octave_quit (); - octave_idx_type iidx = sidx[i]->idx; - octave_idx_type rval = sidx[i]->r; - octave_idx_type cval = sidx[i]->c; - - if (prev_cval < cval || (prev_rval < rval && prev_cval == cval)) - { - octave_idx_type ci = static_cast<octave_idx_type> (c (ci_scalar ? 0 : iidx)); - ii++; - while (cx < ci) - xcidx (++cx) = ii; - xdata(ii) = a (cf_scalar ? 0 : iidx); - xridx(ii) = static_cast<octave_idx_type> (r (ri_scalar ? 0 : iidx)); - } - else - { - if (sum_terms) - xdata(ii) += a (cf_scalar ? 0 : iidx); - else - xdata(ii) = a (cf_scalar ? 0 : iidx); - } - prev_rval = rval; - prev_cval = cval; - } - - while (cx < nc) - xcidx (++cx) = ii + 1; - } + { + octave_quit (); + octave_sort<octave_sparse_sort_idxl *> + lsort (octave_sparse_sidxl_comp); + + lsort.sort (sidx, actual_nzmx); + octave_quit (); + + // Now count the unique non-zero values + octave_idx_type real_nzmx = 1; + for (octave_idx_type i = 1; i < actual_nzmx; i++) + if (sidx[i-1]->r != sidx[i]->r || sidx[i-1]->c != sidx[i]->c) + real_nzmx++; + + rep = new typename Sparse<T>::SparseRep (nr, nc, real_nzmx); + + octave_idx_type cx = 0; + octave_idx_type prev_rval = -1; + octave_idx_type prev_cval = -1; + octave_idx_type ii = -1; + xcidx (0) = 0; + for (octave_idx_type i = 0; i < actual_nzmx; i++) + { + octave_quit (); + octave_idx_type iidx = sidx[i]->idx; + octave_idx_type rval = sidx[i]->r; + octave_idx_type cval = sidx[i]->c; + + if (prev_cval < cval || (prev_rval < rval && prev_cval == cval)) + { + octave_idx_type ci = static_cast<octave_idx_type> (c (ci_scalar ? 0 : iidx)); + ii++; + while (cx < ci) + xcidx (++cx) = ii; + xdata(ii) = a (cf_scalar ? 0 : iidx); + xridx(ii) = static_cast<octave_idx_type> (r (ri_scalar ? 0 : iidx)); + } + else + { + if (sum_terms) + xdata(ii) += a (cf_scalar ? 0 : iidx); + else + xdata(ii) = a (cf_scalar ? 0 : iidx); + } + prev_rval = rval; + prev_cval = cval; + } + + while (cx < nc) + xcidx (++cx) = ii + 1; + } } } template <class T> Sparse<T>::Sparse (const Array<T>& a, const Array<double>& r, - const Array<double>& c, octave_idx_type nr, - octave_idx_type nc, bool sum_terms) + const Array<double>& c, octave_idx_type nr, + octave_idx_type nc, bool sum_terms) : dimensions (dim_vector (nr, nc)), idx (0), idx_count (0) { octave_idx_type a_len = a.length (); @@ -447,7 +447,7 @@ (r_len != c_len && !ri_scalar && !ci_scalar) || nr < 0 || nc < 0) { (*current_liboctave_error_handler) - ("Sparse::Sparse (const Array<T>&, const Array<double>&, ...): dimension mismatch"); + ("Sparse::Sparse (const Array<T>&, const Array<double>&, ...): dimension mismatch"); rep = nil_rep (); dimensions = dim_vector (0, 0); } @@ -459,92 +459,92 @@ OCTAVE_LOCAL_BUFFER (octave_sparse_sort_idxl, sidxX, max_nzmx); for (octave_idx_type i = 0; i < max_nzmx; i++) - sidx[i] = &sidxX[i]; + sidx[i] = &sidxX[i]; octave_idx_type actual_nzmx = 0; octave_quit (); for (octave_idx_type i = 0; i < max_nzmx; i++) - { - octave_idx_type rowidx = static_cast<octave_idx_type> (ri_scalar ? r(0) : r(i)); - octave_idx_type colidx = static_cast<octave_idx_type> (ci_scalar ? c(0) : c(i)); - if (rowidx < nr && rowidx >= 0 && - colidx < nc && colidx >= 0 ) - { - if ( a (cf_scalar ? 0 : i ) != T ()) - { - sidx[actual_nzmx]->r = rowidx; - sidx[actual_nzmx]->c = colidx; - sidx[actual_nzmx]->idx = i; - actual_nzmx++; - } - } - else - { - (*current_liboctave_error_handler) - ("Sparse::Sparse : index (%d,%d) out of range", - rowidx + 1, colidx + 1); - rep = nil_rep (); - dimensions = dim_vector (0, 0); - return; - } - } + { + octave_idx_type rowidx = static_cast<octave_idx_type> (ri_scalar ? r(0) : r(i)); + octave_idx_type colidx = static_cast<octave_idx_type> (ci_scalar ? c(0) : c(i)); + if (rowidx < nr && rowidx >= 0 && + colidx < nc && colidx >= 0 ) + { + if ( a (cf_scalar ? 0 : i ) != T ()) + { + sidx[actual_nzmx]->r = rowidx; + sidx[actual_nzmx]->c = colidx; + sidx[actual_nzmx]->idx = i; + actual_nzmx++; + } + } + else + { + (*current_liboctave_error_handler) + ("Sparse::Sparse : index (%d,%d) out of range", + rowidx + 1, colidx + 1); + rep = nil_rep (); + dimensions = dim_vector (0, 0); + return; + } + } if (actual_nzmx == 0) - rep = new typename Sparse<T>::SparseRep (nr, nc); + rep = new typename Sparse<T>::SparseRep (nr, nc); else - { - octave_quit (); - octave_sort<octave_sparse_sort_idxl *> - lsort (octave_sparse_sidxl_comp); - - lsort.sort (sidx, actual_nzmx); - octave_quit (); - - // Now count the unique non-zero values - octave_idx_type real_nzmx = 1; - for (octave_idx_type i = 1; i < actual_nzmx; i++) - if (sidx[i-1]->r != sidx[i]->r || sidx[i-1]->c != sidx[i]->c) - real_nzmx++; - - rep = new typename Sparse<T>::SparseRep (nr, nc, real_nzmx); - - octave_idx_type cx = 0; - octave_idx_type prev_rval = -1; - octave_idx_type prev_cval = -1; - octave_idx_type ii = -1; - xcidx (0) = 0; - for (octave_idx_type i = 0; i < actual_nzmx; i++) - { - octave_quit (); - octave_idx_type iidx = sidx[i]->idx; - octave_idx_type rval = sidx[i]->r; - octave_idx_type cval = sidx[i]->c; - - if (prev_cval < cval || (prev_rval < rval && prev_cval == cval)) - { - octave_idx_type ci = static_cast<octave_idx_type> (c (ci_scalar ? 0 : iidx)); - ii++; - - while (cx < ci) - xcidx (++cx) = ii; - xdata(ii) = a (cf_scalar ? 0 : iidx); - xridx(ii) = static_cast<octave_idx_type> (r (ri_scalar ? 0 : iidx)); - } - else - { - if (sum_terms) - xdata(ii) += a (cf_scalar ? 0 : iidx); - else - xdata(ii) = a (cf_scalar ? 0 : iidx); - } - prev_rval = rval; - prev_cval = cval; - } - - while (cx < nc) - xcidx (++cx) = ii + 1; - } + { + octave_quit (); + octave_sort<octave_sparse_sort_idxl *> + lsort (octave_sparse_sidxl_comp); + + lsort.sort (sidx, actual_nzmx); + octave_quit (); + + // Now count the unique non-zero values + octave_idx_type real_nzmx = 1; + for (octave_idx_type i = 1; i < actual_nzmx; i++) + if (sidx[i-1]->r != sidx[i]->r || sidx[i-1]->c != sidx[i]->c) + real_nzmx++; + + rep = new typename Sparse<T>::SparseRep (nr, nc, real_nzmx); + + octave_idx_type cx = 0; + octave_idx_type prev_rval = -1; + octave_idx_type prev_cval = -1; + octave_idx_type ii = -1; + xcidx (0) = 0; + for (octave_idx_type i = 0; i < actual_nzmx; i++) + { + octave_quit (); + octave_idx_type iidx = sidx[i]->idx; + octave_idx_type rval = sidx[i]->r; + octave_idx_type cval = sidx[i]->c; + + if (prev_cval < cval || (prev_rval < rval && prev_cval == cval)) + { + octave_idx_type ci = static_cast<octave_idx_type> (c (ci_scalar ? 0 : iidx)); + ii++; + + while (cx < ci) + xcidx (++cx) = ii; + xdata(ii) = a (cf_scalar ? 0 : iidx); + xridx(ii) = static_cast<octave_idx_type> (r (ri_scalar ? 0 : iidx)); + } + else + { + if (sum_terms) + xdata(ii) += a (cf_scalar ? 0 : iidx); + else + xdata(ii) = a (cf_scalar ? 0 : iidx); + } + prev_rval = rval; + prev_cval = cval; + } + + while (cx < nc) + xcidx (++cx) = ii + 1; + } } } @@ -569,11 +569,11 @@ for (octave_idx_type j = 0; j < nc; j++) { for (octave_idx_type i = 0; i < nr; i++) - if (a.elem (i,j) != T ()) - { - xdata(ii) = a.elem (i,j); - xridx(ii++) = i; - } + if (a.elem (i,j) != T ()) + { + xdata(ii) = a.elem (i,j); + xridx(ii++) = i; + } xcidx(j+1) = ii; } } @@ -594,23 +594,23 @@ // First count the number of non-zero terms for (octave_idx_type i = 0; i < len; i++) - if (a(i) != T ()) - new_nzmx++; + if (a(i) != T ()) + new_nzmx++; rep = new typename Sparse<T>::SparseRep (nr, nc, new_nzmx); octave_idx_type ii = 0; xcidx(0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - if (a.elem (i,j) != T ()) - { - xdata(ii) = a.elem (i,j); - xridx(ii++) = i; - } - xcidx(j+1) = ii; - } + { + for (octave_idx_type i = 0; i < nr; i++) + if (a.elem (i,j) != T ()) + { + xdata(ii) = a.elem (i,j); + xridx(ii++) = i; + } + xcidx(j+1) = ii; + } } } @@ -630,7 +630,7 @@ if (this != &a) { if (--rep->count <= 0) - delete rep; + delete rep; rep = a.rep; rep->count++; @@ -658,10 +658,10 @@ retval = ra_idx(--n); while (--n >= 0) - { - retval *= dimensions(n); - retval += ra_idx(n); - } + { + retval *= dimensions(n); + retval += ra_idx(n); + } } else (*current_liboctave_error_handler) @@ -767,10 +767,10 @@ if (dims2.length () > 2) { (*current_liboctave_warning_handler) - ("reshape: sparse reshape to N-d array smashes dims"); + ("reshape: sparse reshape to N-d array smashes dims"); for (octave_idx_type i = 2; i < dims2.length(); i++) - dims2(1) *= dims2(i); + dims2(1) *= dims2(i); dims2.resize (2); } @@ -778,40 +778,40 @@ if (dimensions != dims2) { if (dimensions.numel () == dims2.numel ()) - { - octave_idx_type new_nnz = nnz (); - octave_idx_type new_nr = dims2 (0); - octave_idx_type new_nc = dims2 (1); - octave_idx_type old_nr = rows (); - octave_idx_type old_nc = cols (); - retval = Sparse<T> (new_nr, new_nc, new_nnz); - - octave_idx_type kk = 0; - retval.xcidx(0) = 0; - for (octave_idx_type i = 0; i < old_nc; i++) - for (octave_idx_type j = cidx(i); j < cidx(i+1); j++) - { - octave_idx_type tmp = i * old_nr + ridx(j); - octave_idx_type ii = tmp % new_nr; - octave_idx_type jj = (tmp - ii) / new_nr; - for (octave_idx_type k = kk; k < jj; k++) - retval.xcidx(k+1) = j; - kk = jj; - retval.xdata(j) = data(j); - retval.xridx(j) = ii; - } - for (octave_idx_type k = kk; k < new_nc; k++) - retval.xcidx(k+1) = new_nnz; - } + { + octave_idx_type new_nnz = nnz (); + octave_idx_type new_nr = dims2 (0); + octave_idx_type new_nc = dims2 (1); + octave_idx_type old_nr = rows (); + octave_idx_type old_nc = cols (); + retval = Sparse<T> (new_nr, new_nc, new_nnz); + + octave_idx_type kk = 0; + retval.xcidx(0) = 0; + for (octave_idx_type i = 0; i < old_nc; i++) + for (octave_idx_type j = cidx(i); j < cidx(i+1); j++) + { + octave_idx_type tmp = i * old_nr + ridx(j); + octave_idx_type ii = tmp % new_nr; + octave_idx_type jj = (tmp - ii) / new_nr; + for (octave_idx_type k = kk; k < jj; k++) + retval.xcidx(k+1) = j; + kk = jj; + retval.xdata(j) = data(j); + retval.xridx(j) = ii; + } + for (octave_idx_type k = kk; k < new_nc; k++) + retval.xcidx(k+1) = new_nnz; + } else - { - std::string dimensions_str = dimensions.str (); - std::string new_dims_str = new_dims.str (); - - (*current_liboctave_error_handler) - ("reshape: can't reshape %s array to %s array", - dimensions_str.c_str (), new_dims_str.c_str ()); - } + { + std::string dimensions_str = dimensions.str (); + std::string new_dims_str = new_dims.str (); + + (*current_liboctave_error_handler) + ("reshape: can't reshape %s array to %s array", + dimensions_str.c_str (), new_dims_str.c_str ()); + } } else retval = *this; @@ -831,11 +831,11 @@ if (perm_vec.length () == 2) { if (perm_vec(0) == 0 && perm_vec(1) == 1) - /* do nothing */; + /* do nothing */; else if (perm_vec(0) == 1 && perm_vec(1) == 0) - trans = true; + trans = true; else - fail = true; + fail = true; } else fail = true; @@ -869,7 +869,7 @@ if (r < 0 || c < 0) { (*current_liboctave_error_handler) - ("can't resize to negative dimension"); + ("can't resize to negative dimension"); return; } @@ -893,63 +893,63 @@ octave_idx_type n = 0; Sparse<T> tmpval; if (r >= nr) - { - if (c > nc) - n = xcidx(nc); - else - n = xcidx(c); - - tmpval = Sparse<T> (r, c, n); - - if (c > nc) - { - for (octave_idx_type i = 0; i < nc + 1; i++) - tmpval.cidx(i) = xcidx(i); - for (octave_idx_type i = nc + 1; i < c + 1; i++) - tmpval.cidx(i) = tmpval.cidx(i-1); - } - else if (c <= nc) - for (octave_idx_type i = 0; i < c + 1; i++) - tmpval.cidx(i) = xcidx(i); - - for (octave_idx_type i = 0; i < n; i++) - { - tmpval.data(i) = xdata(i); - tmpval.ridx(i) = xridx(i); - } - } + { + if (c > nc) + n = xcidx(nc); + else + n = xcidx(c); + + tmpval = Sparse<T> (r, c, n); + + if (c > nc) + { + for (octave_idx_type i = 0; i < nc + 1; i++) + tmpval.cidx(i) = xcidx(i); + for (octave_idx_type i = nc + 1; i < c + 1; i++) + tmpval.cidx(i) = tmpval.cidx(i-1); + } + else if (c <= nc) + for (octave_idx_type i = 0; i < c + 1; i++) + tmpval.cidx(i) = xcidx(i); + + for (octave_idx_type i = 0; i < n; i++) + { + tmpval.data(i) = xdata(i); + tmpval.ridx(i) = xridx(i); + } + } else - { - // Count how many non zero terms before we do anything - octave_idx_type min_nc = (c < nc ? c : nc); - for (octave_idx_type i = 0; i < min_nc; i++) - for (octave_idx_type j = xcidx(i); j < xcidx(i+1); j++) - if (xridx(j) < r) - n++; - - if (n) - { - // Now that we know the size we can do something - tmpval = Sparse<T> (r, c, n); - - tmpval.cidx(0); - for (octave_idx_type i = 0, ii = 0; i < min_nc; i++) - { - for (octave_idx_type j = xcidx(i); j < xcidx(i+1); j++) - if (xridx(j) < r) - { - tmpval.data(ii) = xdata(j); - tmpval.ridx(ii++) = xridx(j); - } - tmpval.cidx(i+1) = ii; - } - if (c > min_nc) - for (octave_idx_type i = nc; i < c; i++) - tmpval.cidx(i+1) = tmpval.cidx(i); - } - else - tmpval = Sparse<T> (r, c); - } + { + // Count how many non zero terms before we do anything + octave_idx_type min_nc = (c < nc ? c : nc); + for (octave_idx_type i = 0; i < min_nc; i++) + for (octave_idx_type j = xcidx(i); j < xcidx(i+1); j++) + if (xridx(j) < r) + n++; + + if (n) + { + // Now that we know the size we can do something + tmpval = Sparse<T> (r, c, n); + + tmpval.cidx(0); + for (octave_idx_type i = 0, ii = 0; i < min_nc; i++) + { + for (octave_idx_type j = xcidx(i); j < xcidx(i+1); j++) + if (xridx(j) < r) + { + tmpval.data(ii) = xdata(j); + tmpval.ridx(ii++) = xridx(j); + } + tmpval.cidx(i+1) = ii; + } + if (c > min_nc) + for (octave_idx_type i = nc; i < c; i++) + tmpval.cidx(i+1) = tmpval.cidx(i); + } + else + tmpval = Sparse<T> (r, c); + } rep = tmpval.rep; rep->count++; @@ -985,7 +985,7 @@ for (octave_idx_type i = c; i < c + a_cols; i++) for (octave_idx_type j = cidx(i); j < cidx(i+1); j++) if (ridx(j) < r || ridx(j) >= r + a_rows) - nel++; + nel++; Sparse<T> tmp (*this); --rep->count; @@ -1006,28 +1006,28 @@ octave_quit (); for (octave_idx_type j = tmp.cidx(i); j < tmp.cidx(i+1); j++) - if (tmp.ridx(j) < r) - { - data(ii) = tmp.data(j); - ridx(ii++) = tmp.ridx(j); - } + if (tmp.ridx(j) < r) + { + data(ii) = tmp.data(j); + ridx(ii++) = tmp.ridx(j); + } octave_quit (); for (octave_idx_type j = a.cidx(i-c); j < a.cidx(i-c+1); j++) - { - data(ii) = a.data(j); - ridx(ii++) = r + a.ridx(j); - } + { + data(ii) = a.data(j); + ridx(ii++) = r + a.ridx(j); + } octave_quit (); for (octave_idx_type j = tmp.cidx(i); j < tmp.cidx(i+1); j++) - if (tmp.ridx(j) >= r + a_rows) - { - data(ii) = tmp.data(j); - ridx(ii++) = tmp.ridx(j); - } + if (tmp.ridx(j) >= r + a_rows) + { + data(ii) = tmp.data(j); + ridx(ii++) = tmp.ridx(j); + } cidx(i+1) = ii; } @@ -1035,10 +1035,10 @@ for (octave_idx_type i = c + a_cols; i < nc; i++) { for (octave_idx_type j = tmp.cidx(i); j < tmp.cidx(i+1); j++) - { - data(ii) = tmp.data(j); - ridx(ii++) = tmp.ridx(j); - } + { + data(ii) = tmp.data(j); + ridx(ii++) = tmp.ridx(j); + } cidx(i+1) = ii; } @@ -1085,9 +1085,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) { - octave_idx_type q = retval.xcidx (ridx (k) + 1)++; - retval.xridx (q) = j; - retval.xdata (q) = data (k); + octave_idx_type q = retval.xcidx (ridx (k) + 1)++; + retval.xridx (q) = j; + retval.xdata (q) = data (k); } assert (nnz () == retval.xcidx (nr)); // retval.xcidx[1:nr] holds row entry *end* offsets for rows 0:(nr-1) @@ -1123,7 +1123,7 @@ idx_vector *new_idx = new idx_vector [idx_count+1]; for (octave_idx_type i = 0; i < idx_count; i++) - new_idx[i] = idx[i]; + new_idx[i] = idx[i]; new_idx[idx_count++] = idx_arg; @@ -1182,80 +1182,80 @@ const Sparse<T> tmp (*this); for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - if (i == idx_arg.elem (iidx)) - { - iidx++; - new_n--; - - if (tmp.elem (i) != T ()) - new_nnz--; - - if (iidx == num_to_delete) - break; - } - } + { + octave_quit (); + + if (i == idx_arg.elem (iidx)) + { + iidx++; + new_n--; + + if (tmp.elem (i) != T ()) + new_nnz--; + + if (iidx == num_to_delete) + break; + } + } if (new_n > 0) - { - rep->count--; - - if (nr == 1) - rep = new typename Sparse<T>::SparseRep (1, new_n, new_nnz); - else - rep = new typename Sparse<T>::SparseRep (new_n, 1, new_nnz); - - octave_idx_type ii = 0; - octave_idx_type jj = 0; - iidx = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - if (iidx < num_to_delete && i == idx_arg.elem (iidx)) - iidx++; - else - { - T el = tmp.elem (i); - if (el != T ()) - { - data(ii) = el; - ridx(ii++) = jj; - } - jj++; - } - } - - dimensions.resize (2); - - if (nr == 1) - { - ii = 0; - cidx(0) = 0; - for (octave_idx_type i = 0; i < new_n; i++) - { - octave_quit (); - if (ridx(ii) == i) - ridx(ii++) = 0; - cidx(i+1) = ii; - } - - dimensions(0) = 1; - dimensions(1) = new_n; - } - else - { - cidx(0) = 0; - cidx(1) = new_nnz; - dimensions(0) = new_n; - dimensions(1) = 1; - } - } + { + rep->count--; + + if (nr == 1) + rep = new typename Sparse<T>::SparseRep (1, new_n, new_nnz); + else + rep = new typename Sparse<T>::SparseRep (new_n, 1, new_nnz); + + octave_idx_type ii = 0; + octave_idx_type jj = 0; + iidx = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + if (iidx < num_to_delete && i == idx_arg.elem (iidx)) + iidx++; + else + { + T el = tmp.elem (i); + if (el != T ()) + { + data(ii) = el; + ridx(ii++) = jj; + } + jj++; + } + } + + dimensions.resize (2); + + if (nr == 1) + { + ii = 0; + cidx(0) = 0; + for (octave_idx_type i = 0; i < new_n; i++) + { + octave_quit (); + if (ridx(ii) == i) + ridx(ii++) = 0; + cidx(i+1) = ii; + } + + dimensions(0) = 1; + dimensions(1) = new_n; + } + else + { + cidx(0) = 0; + cidx(1) = new_nnz; + dimensions(0) = new_n; + dimensions(1) = 1; + } + } else - (*current_liboctave_error_handler) - ("A(idx) = []: index out of range"); + (*current_liboctave_error_handler) + ("A(idx) = []: index out of range"); } } @@ -1274,23 +1274,23 @@ if (idx_i.is_colon ()) { if (idx_j.is_colon ()) - { - // A(:,:) -- We are deleting columns and rows, so the result - // is [](0x0). - - resize_no_fill (0, 0); - return; - } + { + // A(:,:) -- We are deleting columns and rows, so the result + // is [](0x0). + + resize_no_fill (0, 0); + return; + } if (idx_j.is_colon_equiv (nc, 1)) - { - // A(:,j) -- We are deleting columns by enumerating them, - // If we enumerate all of them, we should have zero columns - // with the same number of rows that we started with. - - resize_no_fill (nr, 0); - return; - } + { + // A(:,j) -- We are deleting columns by enumerating them, + // If we enumerate all of them, we should have zero columns + // with the same number of rows that we started with. + + resize_no_fill (nr, 0); + return; + } } if (idx_j.is_colon () && idx_i.is_colon_equiv (nr, 1)) @@ -1306,160 +1306,160 @@ if (idx_i.is_colon_equiv (nr, 1)) { if (idx_j.is_colon_equiv (nc, 1)) - resize_no_fill (0, 0); + resize_no_fill (0, 0); else - { - idx_j.sort (true); - - octave_idx_type num_to_delete = idx_j.length (nc); - - if (num_to_delete != 0) - { - if (nr == 1 && num_to_delete == nc) - resize_no_fill (0, 0); - else - { - octave_idx_type new_nc = nc; - octave_idx_type new_nnz = nnz (); - - octave_idx_type iidx = 0; - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - if (j == idx_j.elem (iidx)) - { - iidx++; - new_nc--; - - new_nnz -= cidx(j+1) - cidx(j); - - if (iidx == num_to_delete) - break; - } - } - - if (new_nc > 0) - { - const Sparse<T> tmp (*this); - --rep->count; - rep = new typename Sparse<T>::SparseRep (nr, new_nc, - new_nnz); - octave_idx_type ii = 0; - octave_idx_type jj = 0; - iidx = 0; - cidx(0) = 0; - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - if (iidx < num_to_delete && j == idx_j.elem (iidx)) - iidx++; - else - { - for (octave_idx_type i = tmp.cidx(j); - i < tmp.cidx(j+1); i++) - { - data(jj) = tmp.data(i); - ridx(jj++) = tmp.ridx(i); - } - cidx(++ii) = jj; - } - } - - dimensions.resize (2); - dimensions(1) = new_nc; - } - else - (*current_liboctave_error_handler) - ("A(idx) = []: index out of range"); - } - } - } + { + idx_j.sort (true); + + octave_idx_type num_to_delete = idx_j.length (nc); + + if (num_to_delete != 0) + { + if (nr == 1 && num_to_delete == nc) + resize_no_fill (0, 0); + else + { + octave_idx_type new_nc = nc; + octave_idx_type new_nnz = nnz (); + + octave_idx_type iidx = 0; + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + if (j == idx_j.elem (iidx)) + { + iidx++; + new_nc--; + + new_nnz -= cidx(j+1) - cidx(j); + + if (iidx == num_to_delete) + break; + } + } + + if (new_nc > 0) + { + const Sparse<T> tmp (*this); + --rep->count; + rep = new typename Sparse<T>::SparseRep (nr, new_nc, + new_nnz); + octave_idx_type ii = 0; + octave_idx_type jj = 0; + iidx = 0; + cidx(0) = 0; + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + if (iidx < num_to_delete && j == idx_j.elem (iidx)) + iidx++; + else + { + for (octave_idx_type i = tmp.cidx(j); + i < tmp.cidx(j+1); i++) + { + data(jj) = tmp.data(i); + ridx(jj++) = tmp.ridx(i); + } + cidx(++ii) = jj; + } + } + + dimensions.resize (2); + dimensions(1) = new_nc; + } + else + (*current_liboctave_error_handler) + ("A(idx) = []: index out of range"); + } + } + } } else if (idx_j.is_colon_equiv (nc, 1)) { if (idx_i.is_colon_equiv (nr, 1)) - resize_no_fill (0, 0); + resize_no_fill (0, 0); else - { - idx_i.sort (true); - - octave_idx_type num_to_delete = idx_i.length (nr); - - if (num_to_delete != 0) - { - if (nc == 1 && num_to_delete == nr) - resize_no_fill (0, 0); - else - { - octave_idx_type new_nr = nr; - octave_idx_type new_nnz = nnz (); - - octave_idx_type iidx = 0; - - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - - if (i == idx_i.elem (iidx)) - { - iidx++; - new_nr--; - - for (octave_idx_type j = 0; j < nnz (); j++) - if (ridx(j) == i) - new_nnz--; - - if (iidx == num_to_delete) - break; - } - } - - if (new_nr > 0) - { - const Sparse<T> tmp (*this); - --rep->count; - rep = new typename Sparse<T>::SparseRep (new_nr, nc, - new_nnz); - - octave_idx_type jj = 0; - cidx(0) = 0; - for (octave_idx_type i = 0; i < nc; i++) - { - iidx = 0; - for (octave_idx_type j = tmp.cidx(i); j < tmp.cidx(i+1); j++) - { - octave_quit (); - - octave_idx_type ri = tmp.ridx(j); - - while (iidx < num_to_delete && - ri > idx_i.elem (iidx)) - { - iidx++; - } - - if (iidx == num_to_delete || - ri != idx_i.elem(iidx)) - { - data(jj) = tmp.data(j); - ridx(jj++) = ri - iidx; - } - } - cidx(i+1) = jj; - } - - dimensions.resize (2); - dimensions(0) = new_nr; - } - else - (*current_liboctave_error_handler) - ("A(idx) = []: index out of range"); - } - } - } + { + idx_i.sort (true); + + octave_idx_type num_to_delete = idx_i.length (nr); + + if (num_to_delete != 0) + { + if (nc == 1 && num_to_delete == nr) + resize_no_fill (0, 0); + else + { + octave_idx_type new_nr = nr; + octave_idx_type new_nnz = nnz (); + + octave_idx_type iidx = 0; + + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + + if (i == idx_i.elem (iidx)) + { + iidx++; + new_nr--; + + for (octave_idx_type j = 0; j < nnz (); j++) + if (ridx(j) == i) + new_nnz--; + + if (iidx == num_to_delete) + break; + } + } + + if (new_nr > 0) + { + const Sparse<T> tmp (*this); + --rep->count; + rep = new typename Sparse<T>::SparseRep (new_nr, nc, + new_nnz); + + octave_idx_type jj = 0; + cidx(0) = 0; + for (octave_idx_type i = 0; i < nc; i++) + { + iidx = 0; + for (octave_idx_type j = tmp.cidx(i); j < tmp.cidx(i+1); j++) + { + octave_quit (); + + octave_idx_type ri = tmp.ridx(j); + + while (iidx < num_to_delete && + ri > idx_i.elem (iidx)) + { + iidx++; + } + + if (iidx == num_to_delete || + ri != idx_i.elem(iidx)) + { + data(jj) = tmp.data(j); + ridx(jj++) = ri - iidx; + } + } + cidx(i+1) = jj; + } + + dimensions.resize (2); + dimensions(0) = new_nr; + } + else + (*current_liboctave_error_handler) + ("A(idx) = []: index out of range"); + } + } + } } } @@ -1534,12 +1534,12 @@ retval = Sparse<T> (nr * nc, 1, nz); for (octave_idx_type i = 0; i < nc; i++) - for (octave_idx_type j = cidx(i); j < cidx(i+1); j++) - { - octave_quit (); - retval.xdata(j) = data(j); - retval.xridx(j) = ridx(j) + i * nr; - } + for (octave_idx_type j = cidx(i); j < cidx(i+1); j++) + { + octave_quit (); + retval.xdata(j) = data(j); + retval.xridx(j) = ridx(j) + i * nr; + } retval.xcidx(0) = 0; retval.xcidx(1) = nz; } @@ -1553,52 +1553,52 @@ octave_idx_type n = idx_arg.freeze (length (), "sparse vector", resize_ok); if (n == 0) - retval = Sparse<T> (idx_orig_dims); + retval = Sparse<T> (idx_orig_dims); else if (nz < 1) - if (n >= idx_orig_dims.numel ()) - retval = Sparse<T> (idx_orig_dims); - else - retval = Sparse<T> (dim_vector (n, 1)); + if (n >= idx_orig_dims.numel ()) + retval = Sparse<T> (idx_orig_dims); + else + retval = Sparse<T> (dim_vector (n, 1)); else if (n >= idx_orig_dims.numel ()) - { - T el = elem (0); - octave_idx_type new_nr = idx_orig_rows; - octave_idx_type new_nc = idx_orig_columns; - for (octave_idx_type i = 2; i < idx_orig_dims.length (); i++) - new_nc *= idx_orig_dims (i); - - retval = Sparse<T> (new_nr, new_nc, idx_arg.ones_count ()); - - octave_idx_type ic = 0; - for (octave_idx_type i = 0; i < n; i++) - { - if (i % new_nr == 0) - retval.xcidx(i / new_nr) = ic; - - octave_idx_type ii = idx_arg.elem (i); - if (ii == 0) - { - octave_quit (); - retval.xdata(ic) = el; - retval.xridx(ic++) = i % new_nr; - } - } - retval.xcidx (new_nc) = ic; - } + { + T el = elem (0); + octave_idx_type new_nr = idx_orig_rows; + octave_idx_type new_nc = idx_orig_columns; + for (octave_idx_type i = 2; i < idx_orig_dims.length (); i++) + new_nc *= idx_orig_dims (i); + + retval = Sparse<T> (new_nr, new_nc, idx_arg.ones_count ()); + + octave_idx_type ic = 0; + for (octave_idx_type i = 0; i < n; i++) + { + if (i % new_nr == 0) + retval.xcidx(i / new_nr) = ic; + + octave_idx_type ii = idx_arg.elem (i); + if (ii == 0) + { + octave_quit (); + retval.xdata(ic) = el; + retval.xridx(ic++) = i % new_nr; + } + } + retval.xcidx (new_nc) = ic; + } else - { - T el = elem (0); - retval = Sparse<T> (n, 1, nz); - - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - retval.xdata(i) = el; - retval.xridx(i) = i; - } - retval.xcidx(0) = 0; - retval.xcidx(1) = n; - } + { + T el = elem (0); + retval = Sparse<T> (n, 1, nz); + + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + retval.xdata(i) = el; + retval.xridx(i) = i; + } + retval.xcidx(0) = 0; + retval.xcidx(1) = n; + } } else if (nr == 1 || nc == 1) { @@ -1609,156 +1609,156 @@ octave_idx_type n = idx_arg.freeze (len, "sparse vector", resize_ok); if (n == 0) - if (nr == 1) - retval = Sparse<T> (dim_vector (1, 0)); - else - retval = Sparse<T> (dim_vector (0, 1)); + if (nr == 1) + retval = Sparse<T> (dim_vector (1, 0)); + else + retval = Sparse<T> (dim_vector (0, 1)); else if (nz < 1) - if (idx_orig_rows == 1 || idx_orig_columns == 1) - retval = Sparse<T> ((nr == 1 ? 1 : n), (nr == 1 ? n : 1)); - else - retval = Sparse<T> (idx_orig_dims); + if (idx_orig_rows == 1 || idx_orig_columns == 1) + retval = Sparse<T> ((nr == 1 ? 1 : n), (nr == 1 ? n : 1)); + else + retval = Sparse<T> (idx_orig_dims); else - { - - octave_idx_type new_nzmx = 0; - if (nr == 1) - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - if (cidx(ii) != cidx(ii+1)) - new_nzmx++; - } - else - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - for (octave_idx_type j = 0; j < nz; j++) - { - octave_quit (); - - if (ridx(j) == ii) - new_nzmx++; - if (ridx(j) >= ii) - break; - } - } - - if (idx_orig_rows == 1 || idx_orig_columns == 1) - { - if (nr == 1) - { - retval = Sparse<T> (1, n, new_nzmx); - octave_idx_type jj = 0; - retval.xcidx(0) = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - if (cidx(ii) != cidx(ii+1)) - { - retval.xdata(jj) = data(cidx(ii)); - retval.xridx(jj++) = 0; - } - retval.xcidx(i+1) = jj; - } - } - else - { - retval = Sparse<T> (n, 1, new_nzmx); - retval.xcidx(0) = 0; - retval.xcidx(1) = new_nzmx; - octave_idx_type jj = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - for (octave_idx_type j = 0; j < nz; j++) - { - octave_quit (); - - if (ridx(j) == ii) - { - retval.xdata(jj) = data(j); - retval.xridx(jj++) = i; - } - if (ridx(j) >= ii) - break; - } - } - } - } - else - { - octave_idx_type new_nr; - octave_idx_type new_nc; - if (n >= idx_orig_dims.numel ()) - { - new_nr = idx_orig_rows; - new_nc = idx_orig_columns; - } - else - { - new_nr = n; - new_nc = 1; - } - - retval = Sparse<T> (new_nr, new_nc, new_nzmx); - - if (nr == 1) - { - octave_idx_type jj = 0; - retval.xcidx(0) = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - if (cidx(ii) != cidx(ii+1)) - { - retval.xdata(jj) = data(cidx(ii)); - retval.xridx(jj++) = 0; - } - retval.xcidx(i/new_nr+1) = jj; - } - } - else - { - octave_idx_type jj = 0; - retval.xcidx(0) = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type ii = idx_arg.elem (i); - if (ii < len) - for (octave_idx_type j = 0; j < nz; j++) - { - octave_quit (); - - if (ridx(j) == ii) - { - retval.xdata(jj) = data(j); - retval.xridx(jj++) = i; - } - if (ridx(j) >= ii) - break; - } - retval.xcidx(i/new_nr+1) = jj; - } - } - } - } + { + + octave_idx_type new_nzmx = 0; + if (nr == 1) + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + if (cidx(ii) != cidx(ii+1)) + new_nzmx++; + } + else + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + for (octave_idx_type j = 0; j < nz; j++) + { + octave_quit (); + + if (ridx(j) == ii) + new_nzmx++; + if (ridx(j) >= ii) + break; + } + } + + if (idx_orig_rows == 1 || idx_orig_columns == 1) + { + if (nr == 1) + { + retval = Sparse<T> (1, n, new_nzmx); + octave_idx_type jj = 0; + retval.xcidx(0) = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + if (cidx(ii) != cidx(ii+1)) + { + retval.xdata(jj) = data(cidx(ii)); + retval.xridx(jj++) = 0; + } + retval.xcidx(i+1) = jj; + } + } + else + { + retval = Sparse<T> (n, 1, new_nzmx); + retval.xcidx(0) = 0; + retval.xcidx(1) = new_nzmx; + octave_idx_type jj = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + for (octave_idx_type j = 0; j < nz; j++) + { + octave_quit (); + + if (ridx(j) == ii) + { + retval.xdata(jj) = data(j); + retval.xridx(jj++) = i; + } + if (ridx(j) >= ii) + break; + } + } + } + } + else + { + octave_idx_type new_nr; + octave_idx_type new_nc; + if (n >= idx_orig_dims.numel ()) + { + new_nr = idx_orig_rows; + new_nc = idx_orig_columns; + } + else + { + new_nr = n; + new_nc = 1; + } + + retval = Sparse<T> (new_nr, new_nc, new_nzmx); + + if (nr == 1) + { + octave_idx_type jj = 0; + retval.xcidx(0) = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + if (cidx(ii) != cidx(ii+1)) + { + retval.xdata(jj) = data(cidx(ii)); + retval.xridx(jj++) = 0; + } + retval.xcidx(i/new_nr+1) = jj; + } + } + else + { + octave_idx_type jj = 0; + retval.xcidx(0) = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type ii = idx_arg.elem (i); + if (ii < len) + for (octave_idx_type j = 0; j < nz; j++) + { + octave_quit (); + + if (ridx(j) == ii) + { + retval.xdata(jj) = data(j); + retval.xridx(jj++) = i; + } + if (ridx(j) >= ii) + break; + } + retval.xcidx(i/new_nr+1) = jj; + } + } + } + } } else { (*current_liboctave_warning_with_id_handler) - ("Octave:fortran-indexing", "single index used for sparse matrix"); + ("Octave:fortran-indexing", "single index used for sparse matrix"); // This code is only for indexing matrices. The vector // cases are handled above. @@ -1766,72 +1766,72 @@ idx_arg.freeze (nr * nc, "matrix", resize_ok); if (idx_arg) - { - octave_idx_type result_nr = idx_orig_rows; - octave_idx_type result_nc = idx_orig_columns; - - if (nz < 1) - retval = Sparse<T> (result_nr, result_nc); - else - { - // Count number of non-zero elements - octave_idx_type new_nzmx = 0; - octave_idx_type kk = 0; - for (octave_idx_type j = 0; j < result_nc; j++) - { - for (octave_idx_type i = 0; i < result_nr; i++) - { - octave_quit (); - - octave_idx_type ii = idx_arg.elem (kk++); - if (ii < orig_len) - { - octave_idx_type fr = ii % nr; - octave_idx_type fc = (ii - fr) / nr; - for (octave_idx_type k = cidx(fc); k < cidx(fc+1); k++) - { - if (ridx(k) == fr) - new_nzmx++; - if (ridx(k) >= fr) - break; - } - } - } - } - - retval = Sparse<T> (result_nr, result_nc, new_nzmx); - - kk = 0; - octave_idx_type jj = 0; - retval.xcidx(0) = 0; - for (octave_idx_type j = 0; j < result_nc; j++) - { - for (octave_idx_type i = 0; i < result_nr; i++) - { - octave_quit (); - - octave_idx_type ii = idx_arg.elem (kk++); - if (ii < orig_len) - { - octave_idx_type fr = ii % nr; - octave_idx_type fc = (ii - fr) / nr; - for (octave_idx_type k = cidx(fc); k < cidx(fc+1); k++) - { - if (ridx(k) == fr) - { - retval.xdata(jj) = data(k); - retval.xridx(jj++) = i; - } - if (ridx(k) >= fr) - break; - } - } - } - retval.xcidx(j+1) = jj; - } - } - // idx_vector::freeze() printed an error message for us. - } + { + octave_idx_type result_nr = idx_orig_rows; + octave_idx_type result_nc = idx_orig_columns; + + if (nz < 1) + retval = Sparse<T> (result_nr, result_nc); + else + { + // Count number of non-zero elements + octave_idx_type new_nzmx = 0; + octave_idx_type kk = 0; + for (octave_idx_type j = 0; j < result_nc; j++) + { + for (octave_idx_type i = 0; i < result_nr; i++) + { + octave_quit (); + + octave_idx_type ii = idx_arg.elem (kk++); + if (ii < orig_len) + { + octave_idx_type fr = ii % nr; + octave_idx_type fc = (ii - fr) / nr; + for (octave_idx_type k = cidx(fc); k < cidx(fc+1); k++) + { + if (ridx(k) == fr) + new_nzmx++; + if (ridx(k) >= fr) + break; + } + } + } + } + + retval = Sparse<T> (result_nr, result_nc, new_nzmx); + + kk = 0; + octave_idx_type jj = 0; + retval.xcidx(0) = 0; + for (octave_idx_type j = 0; j < result_nc; j++) + { + for (octave_idx_type i = 0; i < result_nr; i++) + { + octave_quit (); + + octave_idx_type ii = idx_arg.elem (kk++); + if (ii < orig_len) + { + octave_idx_type fr = ii % nr; + octave_idx_type fc = (ii - fr) / nr; + for (octave_idx_type k = cidx(fc); k < cidx(fc+1); k++) + { + if (ridx(k) == fr) + { + retval.xdata(jj) = data(k); + retval.xridx(jj++) = i; + } + if (ridx(k) >= fr) + break; + } + } + } + retval.xcidx(j+1) = jj; + } + } + // idx_vector::freeze() printed an error message for us. + } } return retval; @@ -1842,7 +1842,7 @@ { octave_idx_type i; struct idx_node *next; -}; +}; template <class T> Sparse<T> @@ -1861,203 +1861,203 @@ if (idx_i && idx_j) { if (idx_i.orig_empty () || idx_j.orig_empty () || n == 0 || m == 0) - { - retval.resize_no_fill (n, m); - } + { + retval.resize_no_fill (n, m); + } else - { - 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 - { - // 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> lsort; - - 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); - lsort.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); - lsort.sort (itmp, m); - for (octave_idx_type i = 1; i < m; i++) - if (itmp[i-1] == itmp[i]) - { - permutation = false; - break; - } - } - - if (permutation) - { - // Special case permutation like indexing for speed - retval = Sparse<T> (n, m, nnz ()); - octave_idx_type *ri = retval.xridx (); - - std::vector<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_quit (); - - octave_idx_type ii = itmp [ridx(i)]; - if (ii >= 0) - { - X [ii] = data (i); - retval.xridx (kk++) = ii; - } - } - lsort.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 - { - OCTAVE_LOCAL_BUFFER (struct idx_node, nodes, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, start_nodes, nr); - - for (octave_idx_type i = 0; i < nr; i++) - start_nodes[i] = -1; - - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type ii = idx_i.elem (i); - nodes[i].i = i; - nodes[i].next = 0; - - octave_idx_type node = start_nodes[ii]; - if (node == -1) - start_nodes[ii] = i; - else - { - while (nodes[node].next) - node = nodes[node].next->i; - nodes[node].next = nodes + i; - } - } - - // First count the number of non-zero elements - octave_idx_type new_nzmx = 0; - for (octave_idx_type j = 0; j < m; j++) - { - octave_idx_type jj = idx_j.elem (j); - - if (jj < nc) - { - for (octave_idx_type i = cidx(jj); - i < cidx(jj+1); i++) - { - octave_quit (); - - octave_idx_type ii = start_nodes [ridx(i)]; - - if (ii >= 0) - { - struct idx_node inode = nodes[ii]; - - while (true) - { - if (idx_i.elem (inode.i) < nr) - new_nzmx ++; - if (inode.next == 0) - break; - else - inode = *inode.next; - } - } - } - } - } - - std::vector<T> X (n); - retval = Sparse<T> (n, m, new_nzmx); - octave_idx_type *ri = retval.xridx (); - - 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); - if (jj < nc) - { - for (octave_idx_type i = cidx(jj); - i < cidx(jj+1); i++) - { - octave_quit (); - - octave_idx_type ii = start_nodes [ridx(i)]; - - if (ii >= 0) - { - struct idx_node inode = nodes[ii]; - - while (true) - { - if (idx_i.elem (inode.i) < nr) - { - X [inode.i] = data (i); - retval.xridx (kk++) = inode.i; - } - - if (inode.next == 0) - break; - else - inode = *inode.next; - } - } - } - lsort.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; - } - } - } - } - } + { + 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 + { + // 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> lsort; + + 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); + lsort.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); + lsort.sort (itmp, m); + for (octave_idx_type i = 1; i < m; i++) + if (itmp[i-1] == itmp[i]) + { + permutation = false; + break; + } + } + + if (permutation) + { + // Special case permutation like indexing for speed + retval = Sparse<T> (n, m, nnz ()); + octave_idx_type *ri = retval.xridx (); + + std::vector<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_quit (); + + octave_idx_type ii = itmp [ridx(i)]; + if (ii >= 0) + { + X [ii] = data (i); + retval.xridx (kk++) = ii; + } + } + lsort.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 + { + OCTAVE_LOCAL_BUFFER (struct idx_node, nodes, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, start_nodes, nr); + + for (octave_idx_type i = 0; i < nr; i++) + start_nodes[i] = -1; + + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type ii = idx_i.elem (i); + nodes[i].i = i; + nodes[i].next = 0; + + octave_idx_type node = start_nodes[ii]; + if (node == -1) + start_nodes[ii] = i; + else + { + while (nodes[node].next) + node = nodes[node].next->i; + nodes[node].next = nodes + i; + } + } + + // First count the number of non-zero elements + octave_idx_type new_nzmx = 0; + for (octave_idx_type j = 0; j < m; j++) + { + octave_idx_type jj = idx_j.elem (j); + + if (jj < nc) + { + for (octave_idx_type i = cidx(jj); + i < cidx(jj+1); i++) + { + octave_quit (); + + octave_idx_type ii = start_nodes [ridx(i)]; + + if (ii >= 0) + { + struct idx_node inode = nodes[ii]; + + while (true) + { + if (idx_i.elem (inode.i) < nr) + new_nzmx ++; + if (inode.next == 0) + break; + else + inode = *inode.next; + } + } + } + } + } + + std::vector<T> X (n); + retval = Sparse<T> (n, m, new_nzmx); + octave_idx_type *ri = retval.xridx (); + + 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); + if (jj < nc) + { + for (octave_idx_type i = cidx(jj); + i < cidx(jj+1); i++) + { + octave_quit (); + + octave_idx_type ii = start_nodes [ridx(i)]; + + if (ii >= 0) + { + struct idx_node inode = nodes[ii]; + + while (true) + { + if (idx_i.elem (inode.i) < nr) + { + X [inode.i] = data (i); + retval.xridx (kk++) = inode.i; + } + + if (inode.next == 0) + break; + else + inode = *inode.next; + } + } + } + lsort.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; + } + } + } + } + } } // idx_vector::freeze() printed an error message for us. @@ -2135,21 +2135,21 @@ octave_idx_type i; if (mode == ASCENDING) - { - for (i = 0; i < ns; i++) - if (sparse_ascending_compare<T> (static_cast<T> (0), v [i])) - break; - } + { + for (i = 0; i < ns; i++) + if (sparse_ascending_compare<T> (static_cast<T> (0), v [i])) + break; + } else - { - for (i = 0; i < ns; i++) - if (sparse_descending_compare<T> (static_cast<T> (0), v [i])) - break; - } + { + for (i = 0; i < ns; i++) + if (sparse_descending_compare<T> (static_cast<T> (0), v [i])) + break; + } for (octave_idx_type k = 0; k < i; k++) - mridx [k] = k; + mridx [k] = k; for (octave_idx_type k = i; k < ns; k++) - mridx [k] = k - ns + nr; + mridx [k] = k - ns + nr; v += ns; mridx += ns; @@ -2164,7 +2164,7 @@ template <class T> Sparse<T> Sparse<T>::sort (Array<octave_idx_type> &sidx, octave_idx_type dim, - sortmode mode) const + sortmode mode) const { Sparse<T> m = *this; @@ -2206,56 +2206,56 @@ octave_idx_type offset = j * nr; if (ns == 0) - { - for (octave_idx_type k = 0; k < nr; k++) - sidx (offset + k) = k; - } + { + for (octave_idx_type k = 0; k < nr; k++) + sidx (offset + k) = k; + } else - { - for (octave_idx_type i = 0; i < ns; i++) + { + for (octave_idx_type i = 0; i < ns; i++) vi[i] = mridx[i]; - indexed_sort.sort (v, vi, ns); - - octave_idx_type i; - if (mode == ASCENDING) - { - for (i = 0; i < ns; i++) - if (sparse_ascending_compare<T> (static_cast<T> (0), v[i])) - break; - } - else - { - for (i = 0; i < ns; i++) - if (sparse_descending_compare<T> (static_cast<T> (0), v[i])) - break; - } - - octave_idx_type ii = 0; - octave_idx_type jj = i; - for (octave_idx_type k = 0; k < nr; k++) - { - if (ii < ns && mridx[ii] == k) - ii++; - else - sidx (offset + jj++) = k; - } - - for (octave_idx_type k = 0; k < i; k++) - { - sidx (k + offset) = vi [k]; - mridx [k] = k; - } - - for (octave_idx_type k = i; k < ns; k++) - { - sidx (k - ns + nr + offset) = vi [k]; - mridx [k] = k - ns + nr; - } - - v += ns; - mridx += ns; - } + indexed_sort.sort (v, vi, ns); + + octave_idx_type i; + if (mode == ASCENDING) + { + for (i = 0; i < ns; i++) + if (sparse_ascending_compare<T> (static_cast<T> (0), v[i])) + break; + } + else + { + for (i = 0; i < ns; i++) + if (sparse_descending_compare<T> (static_cast<T> (0), v[i])) + break; + } + + octave_idx_type ii = 0; + octave_idx_type jj = i; + for (octave_idx_type k = 0; k < nr; k++) + { + if (ii < ns && mridx[ii] == k) + ii++; + else + sidx (offset + jj++) = k; + } + + for (octave_idx_type k = 0; k < i; k++) + { + sidx (k + offset) = vi [k]; + mridx [k] = k; + } + + for (octave_idx_type k = i; k < ns; k++) + { + sidx (k - ns + nr + offset) = vi [k]; + mridx [k] = k - ns + nr; + } + + v += ns; + mridx += ns; + } } if (dim > 0) @@ -2280,138 +2280,138 @@ else if (nnr != 1 && nnc != 1) { if (k > 0) - nnc -= k; + nnc -= k; else if (k < 0) - nnr += k; + nnr += k; if (nnr > 0 && nnc > 0) - { - octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; - - // Count the number of non-zero elements - octave_idx_type nel = 0; - if (k > 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - if (elem (i, i+k) != 0.) - nel++; - } - else if ( k < 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - if (elem (i-k, i) != 0.) - nel++; - } - else - { - for (octave_idx_type i = 0; i < ndiag; i++) - if (elem (i, i) != 0.) - nel++; - } + { + octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; + + // Count the number of non-zero elements + octave_idx_type nel = 0; + if (k > 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + if (elem (i, i+k) != 0.) + nel++; + } + else if ( k < 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + if (elem (i-k, i) != 0.) + nel++; + } + else + { + for (octave_idx_type i = 0; i < ndiag; i++) + if (elem (i, i) != 0.) + nel++; + } - d = Sparse<T> (ndiag, 1, nel); - d.xcidx (0) = 0; - d.xcidx (1) = nel; - - octave_idx_type ii = 0; - if (k > 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - { - T tmp = elem (i, i+k); - if (tmp != 0.) - { - d.xdata (ii) = tmp; - d.xridx (ii++) = i; - } - } - } - else if ( k < 0) - { - for (octave_idx_type i = 0; i < ndiag; i++) - { - T tmp = elem (i-k, i); - if (tmp != 0.) - { - d.xdata (ii) = tmp; - d.xridx (ii++) = i; - } - } - } - else - { - for (octave_idx_type i = 0; i < ndiag; i++) - { - T tmp = elem (i, i); - if (tmp != 0.) - { - d.xdata (ii) = tmp; - d.xridx (ii++) = i; - } - } - } - } + d = Sparse<T> (ndiag, 1, nel); + d.xcidx (0) = 0; + d.xcidx (1) = nel; + + octave_idx_type ii = 0; + if (k > 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + { + T tmp = elem (i, i+k); + if (tmp != 0.) + { + d.xdata (ii) = tmp; + d.xridx (ii++) = i; + } + } + } + else if ( k < 0) + { + for (octave_idx_type i = 0; i < ndiag; i++) + { + T tmp = elem (i-k, i); + if (tmp != 0.) + { + d.xdata (ii) = tmp; + d.xridx (ii++) = i; + } + } + } + else + { + for (octave_idx_type i = 0; i < ndiag; i++) + { + T tmp = elem (i, i); + if (tmp != 0.) + { + d.xdata (ii) = tmp; + d.xridx (ii++) = i; + } + } + } + } else - (*current_liboctave_error_handler) - ("diag: requested diagonal out of range"); + (*current_liboctave_error_handler) + ("diag: requested diagonal out of range"); } else if (nnr != 0 && nnc != 0) { octave_idx_type roff = 0; octave_idx_type coff = 0; if (k > 0) - { - roff = 0; - coff = k; - } + { + roff = 0; + coff = k; + } else if (k < 0) - { - roff = -k; - coff = 0; - } + { + roff = -k; + coff = 0; + } if (nnr == 1) - { - octave_idx_type n = nnc + std::abs (k); - octave_idx_type nz = nzmax (); - d = Sparse<T> (n, n, nz); - for (octave_idx_type i = 0; i < coff+1; i++) - d.xcidx (i) = 0; - for (octave_idx_type j = 0; j < nnc; j++) - { - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - d.xdata (i) = data (i); - d.xridx (i) = j + roff; - } - d.xcidx (j + coff + 1) = cidx(j+1); - } - for (octave_idx_type i = nnc + coff + 1; i < n + 1; i++) - d.xcidx (i) = nz; - } + { + octave_idx_type n = nnc + std::abs (k); + octave_idx_type nz = nzmax (); + d = Sparse<T> (n, n, nz); + for (octave_idx_type i = 0; i < coff+1; i++) + d.xcidx (i) = 0; + for (octave_idx_type j = 0; j < nnc; j++) + { + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + d.xdata (i) = data (i); + d.xridx (i) = j + roff; + } + d.xcidx (j + coff + 1) = cidx(j+1); + } + for (octave_idx_type i = nnc + coff + 1; i < n + 1; i++) + d.xcidx (i) = nz; + } else - { - octave_idx_type n = nnr + std::abs (k); - octave_idx_type nz = nzmax (); - octave_idx_type ii = 0; - octave_idx_type ir = ridx(0); - d = Sparse<T> (n, n, nz); - for (octave_idx_type i = 0; i < coff+1; i++) - d.xcidx (i) = 0; - for (octave_idx_type i = 0; i < nnr; i++) - { - if (ir == i) - { - d.xdata (ii) = data (ii); - d.xridx (ii++) = ir + roff; - if (ii != nz) - ir = ridx (ii); - } - d.xcidx (i + coff + 1) = ii; - } - for (octave_idx_type i = nnr + coff + 1; i < n+1; i++) - d.xcidx (i) = nz; - } + { + octave_idx_type n = nnr + std::abs (k); + octave_idx_type nz = nzmax (); + octave_idx_type ii = 0; + octave_idx_type ir = ridx(0); + d = Sparse<T> (n, n, nz); + for (octave_idx_type i = 0; i < coff+1; i++) + d.xcidx (i) = 0; + for (octave_idx_type i = 0; i < nnr; i++) + { + if (ir == i) + { + d.xdata (ii) = data (ii); + d.xridx (ii++) = ir + roff; + if (ii != nz) + ir = ridx (ii); + } + d.xcidx (i + coff + 1) = ii; + } + for (octave_idx_type i = nnr + coff + 1; i < n+1; i++) + d.xcidx (i) = nz; + } } return d; @@ -2445,9 +2445,9 @@ long_lhs_len != static_cast<uint64_t>(lhs_len)) { (*current_liboctave_error_handler) - ("A(I) = X: Matrix dimensions too large to ensure correct\n", - "operation. This is an limitation that should be removed\n", - "in the future."); + ("A(I) = X: Matrix dimensions too large to ensure correct\n", + "operation. This is an limitation that should be removed\n", + "in the future."); lhs.clear_index (); return 0; @@ -2469,331 +2469,331 @@ const Sparse<LT> c_lhs (lhs); if (rhs_len == n) - { - octave_idx_type new_nzmx = lhs.nnz (); - - OCTAVE_LOCAL_BUFFER (octave_idx_type, rhs_idx, n); - if (! lhs_idx.is_colon ()) - { - // Ok here we have to be careful with the indexing, - // to treat cases like "a([3,2,1]) = b", and still - // handle the need for strict sorting of the sparse - // elements. - OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort *, sidx, n); - OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort, sidxX, n); - - for (octave_idx_type i = 0; i < n; i++) - { - sidx[i] = &sidxX[i]; - sidx[i]->i = lhs_idx.elem(i); - sidx[i]->idx = i; - } - - octave_quit (); - octave_sort<octave_idx_vector_sort *> - sort (octave_idx_vector_comp); - - sort.sort (sidx, n); - - intNDArray<octave_idx_type> new_idx (dim_vector (n,1)); - - for (octave_idx_type i = 0; i < n; i++) - { - new_idx.xelem(i) = sidx[i]->i; - rhs_idx[i] = sidx[i]->idx; - } - - lhs_idx = idx_vector (new_idx); - } - else - for (octave_idx_type i = 0; i < n; i++) - rhs_idx[i] = i; - - // First count the number of non-zero elements - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - octave_idx_type ii = lhs_idx.elem (i); - if (i < n - 1 && lhs_idx.elem (i + 1) == ii) - continue; - if (ii < lhs_len && c_lhs.elem(ii) != LT ()) - new_nzmx--; - if (rhs.elem(rhs_idx[i]) != RT ()) - new_nzmx++; - } - - if (nr > 1) - { - Sparse<LT> tmp ((max_idx > nr ? max_idx : nr), 1, new_nzmx); - tmp.cidx(0) = 0; - tmp.cidx(1) = new_nzmx; - - octave_idx_type i = 0; - octave_idx_type ii = 0; - if (i < nz) - ii = c_lhs.ridx(i); - - octave_idx_type j = 0; - octave_idx_type jj = lhs_idx.elem(j); - - octave_idx_type kk = 0; - - while (j < n || i < nz) - { - if (j < n - 1 && lhs_idx.elem (j + 1) == jj) - { - j++; - jj = lhs_idx.elem (j); - continue; - } - if (j == n || (i < nz && ii < jj)) - { - tmp.xdata (kk) = c_lhs.data (i); - tmp.xridx (kk++) = ii; - if (++i < nz) - ii = c_lhs.ridx(i); - } - else - { - RT rtmp = rhs.elem (rhs_idx[j]); - if (rtmp != RT ()) - { - tmp.xdata (kk) = rtmp; - tmp.xridx (kk++) = jj; - } - - if (ii == jj && i < nz) - if (++i < nz) - ii = c_lhs.ridx(i); - if (++j < n) - jj = lhs_idx.elem(j); - } - } - - lhs = tmp; - } - else - { - Sparse<LT> tmp (1, (max_idx > nc ? max_idx : nc), new_nzmx); - - octave_idx_type i = 0; - octave_idx_type ii = 0; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; - - octave_idx_type j = 0; - octave_idx_type jj = lhs_idx.elem(j); - - octave_idx_type kk = 0; - octave_idx_type ic = 0; - - while (j < n || i < nz) - { - if (j < n - 1 && lhs_idx.elem (j + 1) == jj) - { - j++; - jj = lhs_idx.elem (j); - continue; - } - if (j == n || (i < nz && ii < jj)) - { - while (ic <= ii) - tmp.xcidx (ic++) = kk; - tmp.xdata (kk) = c_lhs.data (i); - tmp.xridx (kk++) = 0; - i++; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; - } - else - { - while (ic <= jj) - tmp.xcidx (ic++) = kk; - - RT rtmp = rhs.elem (rhs_idx[j]); - if (rtmp != RT ()) - { - tmp.xdata (kk) = rtmp; - tmp.xridx (kk++) = 0; - } - if (ii == jj) - { - i++; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; - } - j++; - if (j < n) - jj = lhs_idx.elem(j); - } - } - - for (octave_idx_type iidx = ic; iidx < max_idx+1; iidx++) - tmp.xcidx(iidx) = kk; - - lhs = tmp; - } - } + { + octave_idx_type new_nzmx = lhs.nnz (); + + OCTAVE_LOCAL_BUFFER (octave_idx_type, rhs_idx, n); + if (! lhs_idx.is_colon ()) + { + // Ok here we have to be careful with the indexing, + // to treat cases like "a([3,2,1]) = b", and still + // handle the need for strict sorting of the sparse + // elements. + OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort *, sidx, n); + OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort, sidxX, n); + + for (octave_idx_type i = 0; i < n; i++) + { + sidx[i] = &sidxX[i]; + sidx[i]->i = lhs_idx.elem(i); + sidx[i]->idx = i; + } + + octave_quit (); + octave_sort<octave_idx_vector_sort *> + sort (octave_idx_vector_comp); + + sort.sort (sidx, n); + + intNDArray<octave_idx_type> new_idx (dim_vector (n,1)); + + for (octave_idx_type i = 0; i < n; i++) + { + new_idx.xelem(i) = sidx[i]->i; + rhs_idx[i] = sidx[i]->idx; + } + + lhs_idx = idx_vector (new_idx); + } + else + for (octave_idx_type i = 0; i < n; i++) + rhs_idx[i] = i; + + // First count the number of non-zero elements + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + octave_idx_type ii = lhs_idx.elem (i); + if (i < n - 1 && lhs_idx.elem (i + 1) == ii) + continue; + if (ii < lhs_len && c_lhs.elem(ii) != LT ()) + new_nzmx--; + if (rhs.elem(rhs_idx[i]) != RT ()) + new_nzmx++; + } + + if (nr > 1) + { + Sparse<LT> tmp ((max_idx > nr ? max_idx : nr), 1, new_nzmx); + tmp.cidx(0) = 0; + tmp.cidx(1) = new_nzmx; + + octave_idx_type i = 0; + octave_idx_type ii = 0; + if (i < nz) + ii = c_lhs.ridx(i); + + octave_idx_type j = 0; + octave_idx_type jj = lhs_idx.elem(j); + + octave_idx_type kk = 0; + + while (j < n || i < nz) + { + if (j < n - 1 && lhs_idx.elem (j + 1) == jj) + { + j++; + jj = lhs_idx.elem (j); + continue; + } + if (j == n || (i < nz && ii < jj)) + { + tmp.xdata (kk) = c_lhs.data (i); + tmp.xridx (kk++) = ii; + if (++i < nz) + ii = c_lhs.ridx(i); + } + else + { + RT rtmp = rhs.elem (rhs_idx[j]); + if (rtmp != RT ()) + { + tmp.xdata (kk) = rtmp; + tmp.xridx (kk++) = jj; + } + + if (ii == jj && i < nz) + if (++i < nz) + ii = c_lhs.ridx(i); + if (++j < n) + jj = lhs_idx.elem(j); + } + } + + lhs = tmp; + } + else + { + Sparse<LT> tmp (1, (max_idx > nc ? max_idx : nc), new_nzmx); + + octave_idx_type i = 0; + octave_idx_type ii = 0; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; + + octave_idx_type j = 0; + octave_idx_type jj = lhs_idx.elem(j); + + octave_idx_type kk = 0; + octave_idx_type ic = 0; + + while (j < n || i < nz) + { + if (j < n - 1 && lhs_idx.elem (j + 1) == jj) + { + j++; + jj = lhs_idx.elem (j); + continue; + } + if (j == n || (i < nz && ii < jj)) + { + while (ic <= ii) + tmp.xcidx (ic++) = kk; + tmp.xdata (kk) = c_lhs.data (i); + tmp.xridx (kk++) = 0; + i++; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; + } + else + { + while (ic <= jj) + tmp.xcidx (ic++) = kk; + + RT rtmp = rhs.elem (rhs_idx[j]); + if (rtmp != RT ()) + { + tmp.xdata (kk) = rtmp; + tmp.xridx (kk++) = 0; + } + if (ii == jj) + { + i++; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; + } + j++; + if (j < n) + jj = lhs_idx.elem(j); + } + } + + for (octave_idx_type iidx = ic; iidx < max_idx+1; iidx++) + tmp.xcidx(iidx) = kk; + + lhs = tmp; + } + } else if (rhs_len == 1) - { - octave_idx_type new_nzmx = lhs.nnz (); - RT scalar = rhs.elem (0); - bool scalar_non_zero = (scalar != RT ()); - lhs_idx.sort (true); - n = lhs_idx.length (n); - - // First count the number of non-zero elements - if (scalar != RT ()) - new_nzmx += n; - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - octave_idx_type ii = lhs_idx.elem (i); - if (ii < lhs_len && c_lhs.elem(ii) != LT ()) - new_nzmx--; - } - - if (nr > 1) - { - Sparse<LT> tmp ((max_idx > nr ? max_idx : nr), 1, new_nzmx); - tmp.cidx(0) = 0; - tmp.cidx(1) = new_nzmx; - - octave_idx_type i = 0; - octave_idx_type ii = 0; - if (i < nz) - ii = c_lhs.ridx(i); - - octave_idx_type j = 0; - octave_idx_type jj = lhs_idx.elem(j); - - octave_idx_type kk = 0; - - while (j < n || i < nz) - { - if (j == n || (i < nz && ii < jj)) - { - tmp.xdata (kk) = c_lhs.data (i); - tmp.xridx (kk++) = ii; - if (++i < nz) - ii = c_lhs.ridx(i); - } - else - { - if (scalar_non_zero) - { - tmp.xdata (kk) = scalar; - tmp.xridx (kk++) = jj; - } - - if (ii == jj && i < nz) - if (++i < nz) - ii = c_lhs.ridx(i); - if (++j < n) - jj = lhs_idx.elem(j); - } - } - - lhs = tmp; - } - else - { - Sparse<LT> tmp (1, (max_idx > nc ? max_idx : nc), new_nzmx); - - octave_idx_type i = 0; - octave_idx_type ii = 0; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; - - octave_idx_type j = 0; - octave_idx_type jj = lhs_idx.elem(j); - - octave_idx_type kk = 0; - octave_idx_type ic = 0; - - while (j < n || i < nz) - { - if (j == n || (i < nz && ii < jj)) - { - while (ic <= ii) - tmp.xcidx (ic++) = kk; - tmp.xdata (kk) = c_lhs.data (i); - i++; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; + { + octave_idx_type new_nzmx = lhs.nnz (); + RT scalar = rhs.elem (0); + bool scalar_non_zero = (scalar != RT ()); + lhs_idx.sort (true); + n = lhs_idx.length (n); + + // First count the number of non-zero elements + if (scalar != RT ()) + new_nzmx += n; + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + octave_idx_type ii = lhs_idx.elem (i); + if (ii < lhs_len && c_lhs.elem(ii) != LT ()) + new_nzmx--; + } + + if (nr > 1) + { + Sparse<LT> tmp ((max_idx > nr ? max_idx : nr), 1, new_nzmx); + tmp.cidx(0) = 0; + tmp.cidx(1) = new_nzmx; + + octave_idx_type i = 0; + octave_idx_type ii = 0; + if (i < nz) + ii = c_lhs.ridx(i); + + octave_idx_type j = 0; + octave_idx_type jj = lhs_idx.elem(j); + + octave_idx_type kk = 0; + + while (j < n || i < nz) + { + if (j == n || (i < nz && ii < jj)) + { + tmp.xdata (kk) = c_lhs.data (i); + tmp.xridx (kk++) = ii; + if (++i < nz) + ii = c_lhs.ridx(i); + } + else + { + if (scalar_non_zero) + { + tmp.xdata (kk) = scalar; + tmp.xridx (kk++) = jj; + } + + if (ii == jj && i < nz) + if (++i < nz) + ii = c_lhs.ridx(i); + if (++j < n) + jj = lhs_idx.elem(j); + } + } + + lhs = tmp; + } + else + { + Sparse<LT> tmp (1, (max_idx > nc ? max_idx : nc), new_nzmx); + + octave_idx_type i = 0; + octave_idx_type ii = 0; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; + + octave_idx_type j = 0; + octave_idx_type jj = lhs_idx.elem(j); + + octave_idx_type kk = 0; + octave_idx_type ic = 0; + + while (j < n || i < nz) + { + if (j == n || (i < nz && ii < jj)) + { + while (ic <= ii) + tmp.xcidx (ic++) = kk; + tmp.xdata (kk) = c_lhs.data (i); + i++; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; tmp.xridx (kk++) = 0; - } - else - { - while (ic <= jj) - tmp.xcidx (ic++) = kk; - if (scalar_non_zero) + } + else + { + while (ic <= jj) + tmp.xcidx (ic++) = kk; + if (scalar_non_zero) { tmp.xdata (kk) = scalar; tmp.xridx (kk++) = 0; } - if (ii == jj) - { - i++; - while (ii < nc && c_lhs.cidx(ii+1) <= i) - ii++; - } - j++; - if (j < n) - jj = lhs_idx.elem(j); - } - } - - for (octave_idx_type iidx = ic; iidx < max_idx+1; iidx++) - tmp.xcidx(iidx) = kk; - - lhs = tmp; - } - } + if (ii == jj) + { + i++; + while (ii < nc && c_lhs.cidx(ii+1) <= i) + ii++; + } + j++; + if (j < n) + jj = lhs_idx.elem(j); + } + } + + for (octave_idx_type iidx = ic; iidx < max_idx+1; iidx++) + tmp.xcidx(iidx) = kk; + + lhs = tmp; + } + } else - { - (*current_liboctave_error_handler) - ("A(I) = X: X must be a scalar or a vector with same length as I"); - - retval = 0; - } + { + (*current_liboctave_error_handler) + ("A(I) = X: X must be a scalar or a vector with same length as I"); + + retval = 0; + } } else if (lhs_idx.is_colon ()) { if (lhs_len == 0) - { - - octave_idx_type new_nzmx = rhs.nnz (); - Sparse<LT> tmp (1, rhs_len, new_nzmx); - - octave_idx_type ii = 0; - octave_idx_type jj = 0; - for (octave_idx_type i = 0; i < rhs.cols(); i++) - for (octave_idx_type j = rhs.cidx(i); j < rhs.cidx(i+1); j++) - { - octave_quit (); - for (octave_idx_type k = jj; k <= i * rhs.rows() + rhs.ridx(j); k++) - tmp.cidx(jj++) = ii; - - tmp.data(ii) = rhs.data(j); - tmp.ridx(ii++) = 0; - } - - for (octave_idx_type i = jj; i < rhs_len + 1; i++) - tmp.cidx(i) = ii; - - lhs = tmp; - } + { + + octave_idx_type new_nzmx = rhs.nnz (); + Sparse<LT> tmp (1, rhs_len, new_nzmx); + + octave_idx_type ii = 0; + octave_idx_type jj = 0; + for (octave_idx_type i = 0; i < rhs.cols(); i++) + for (octave_idx_type j = rhs.cidx(i); j < rhs.cidx(i+1); j++) + { + octave_quit (); + for (octave_idx_type k = jj; k <= i * rhs.rows() + rhs.ridx(j); k++) + tmp.cidx(jj++) = ii; + + tmp.data(ii) = rhs.data(j); + tmp.ridx(ii++) = 0; + } + + for (octave_idx_type i = jj; i < rhs_len + 1; i++) + tmp.cidx(i) = ii; + + lhs = tmp; + } else - (*current_liboctave_error_handler) - ("A(:) = X: A must be the same size as X"); + (*current_liboctave_error_handler) + ("A(:) = X: A must be the same size as X"); } else if (! (rhs_len == 1 || rhs_len == 0)) { (*current_liboctave_error_handler) - ("A([]) = X: X must also be an empty matrix or a scalar"); + ("A([]) = X: X must also be an empty matrix or a scalar"); retval = 0; } @@ -2851,13 +2851,13 @@ int idx_j_is_colon = idx_j.is_colon (); if (lhs_nr == 0 && lhs_nc == 0) - { - if (idx_i_is_colon) - n = rhs_nr; - - if (idx_j_is_colon) - m = rhs_nc; - } + { + if (idx_i_is_colon) + n = rhs_nr; + + if (idx_j_is_colon) + m = rhs_nc; + } if (idx_i && idx_j) { @@ -2940,7 +2940,7 @@ stmp.ridx(kk++) = ii; } if (ii == pp) - pp = (++ppp < ppi ? c_lhs.ridx(c_lhs.cidx(j)+ppp) : new_nr); + pp = (++ppp < ppi ? c_lhs.ridx(c_lhs.cidx(j)+ppp) : new_nr); if (++iii < n) ii = idx_i.elem(iii); } @@ -3147,7 +3147,7 @@ stmp.ridx(kk++) = ii; } if (ii == pp) - pp = (++ppp < ppi ? c_lhs.ridx(c_lhs.cidx(j)+ppp) : new_nr); + pp = (++ppp < ppi ? c_lhs.ridx(c_lhs.cidx(j)+ppp) : new_nr); if (++iii < n) ii = idx_i.elem(iii); } @@ -3208,13 +3208,13 @@ int lhs_is_empty = lhs_nr == 0 || lhs_nc == 0; if (lhs_is_empty || (lhs_nr == 1 && lhs_nc == 1)) - { - octave_idx_type lhs_len = lhs.length (); - - // Called for side-effects on idx_i. - idx_i.freeze (lhs_len, 0, true); - - if (idx_i) + { + octave_idx_type lhs_len = lhs.length (); + + // Called for side-effects on idx_i. + idx_i.freeze (lhs_len, 0, true); + + if (idx_i) { if (lhs_is_empty && idx_i.is_colon () @@ -3238,281 +3238,281 @@ if (! assign1 (lhs, rhs)) retval = 0; } - // idx_vector::freeze() printed an error message for us. - } + // idx_vector::freeze() printed an error message for us. + } else if (lhs_nr == 1) - { - idx_i.freeze (lhs_nc, "vector", true); - - if (idx_i) + { + idx_i.freeze (lhs_nc, "vector", true); + + if (idx_i) + { + if (! assign1 (lhs, rhs)) + retval = 0; + } + // idx_vector::freeze() printed an error message for us. + } + else if (lhs_nc == 1) + { + idx_i.freeze (lhs_nr, "vector", true); + + if (idx_i) { if (! assign1 (lhs, rhs)) retval = 0; } - // idx_vector::freeze() printed an error message for us. - } - else if (lhs_nc == 1) - { - idx_i.freeze (lhs_nr, "vector", true); - - if (idx_i) - { - if (! assign1 (lhs, rhs)) - retval = 0; - } - // idx_vector::freeze() printed an error message for us. - } + // idx_vector::freeze() printed an error message for us. + } else - { - if (! idx_i.is_colon ()) - (*current_liboctave_warning_with_id_handler) - ("Octave:fortran-indexing", "single index used for matrix"); - - octave_idx_type lhs_len = lhs.length (); - - octave_idx_type len = idx_i.freeze (lhs_nr * lhs_nc, "matrix"); - - if (idx_i) - { - if (len == 0) - { - if (! ((rhs_nr == 1 && rhs_nc == 1) - || (rhs_nr == 0 || rhs_nc == 0))) - (*current_liboctave_error_handler) - ("A([]) = X: X must be an empty matrix or scalar"); - } - else if (len == rhs_nr * rhs_nc) - { - octave_idx_type new_nzmx = lhs_nz; - OCTAVE_LOCAL_BUFFER (octave_idx_type, rhs_idx, len); - - if (! idx_i.is_colon ()) - { - // Ok here we have to be careful with the indexing, to - // treat cases like "a([3,2,1]) = b", and still handle - // the need for strict sorting of the sparse elements. - - OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort *, sidx, - len); - OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort, sidxX, - len); - - for (octave_idx_type i = 0; i < len; i++) - { - sidx[i] = &sidxX[i]; - sidx[i]->i = idx_i.elem(i); - sidx[i]->idx = i; - } - - octave_quit (); - octave_sort<octave_idx_vector_sort *> - sort (octave_idx_vector_comp); - - sort.sort (sidx, len); - - intNDArray<octave_idx_type> new_idx (dim_vector (len,1)); - - for (octave_idx_type i = 0; i < len; i++) - { - new_idx.xelem(i) = sidx[i]->i; - rhs_idx[i] = sidx[i]->idx; - } - - idx_i = idx_vector (new_idx); - } - else - for (octave_idx_type i = 0; i < len; i++) - rhs_idx[i] = i; - - // First count the number of non-zero elements - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - - octave_idx_type ii = idx_i.elem (i); - if (i < len - 1 && idx_i.elem (i + 1) == ii) - continue; - if (ii < lhs_len && c_lhs.elem(ii) != LT ()) - new_nzmx--; - if (rhs.elem(rhs_idx[i]) != RT ()) - new_nzmx++; - } - - Sparse<LT> stmp (lhs_nr, lhs_nc, new_nzmx); - - octave_idx_type i = 0; - octave_idx_type ii = 0; - octave_idx_type ic = 0; - if (i < lhs_nz) - { - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - ii = ic * lhs_nr + c_lhs.ridx(i); - } - - octave_idx_type j = 0; - octave_idx_type jj = idx_i.elem (j); - octave_idx_type jr = jj % lhs_nr; - octave_idx_type jc = (jj - jr) / lhs_nr; - - octave_idx_type kk = 0; - octave_idx_type kc = 0; - - while (j < len || i < lhs_nz) - { - if (j < len - 1 && idx_i.elem (j + 1) == jj) - { - j++; - jj = idx_i.elem (j); - jr = jj % lhs_nr; - jc = (jj - jr) / lhs_nr; - continue; - } - - if (j == len || (i < lhs_nz && ii < jj)) - { - while (kc <= ic) - stmp.xcidx (kc++) = kk; - stmp.xdata (kk) = c_lhs.data (i); - stmp.xridx (kk++) = c_lhs.ridx (i); - i++; - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - if (i < lhs_nz) - ii = ic * lhs_nr + c_lhs.ridx(i); - } - else - { - while (kc <= jc) - stmp.xcidx (kc++) = kk; - RT rtmp = rhs.elem (rhs_idx[j]); - if (rtmp != RT ()) - { - stmp.xdata (kk) = rtmp; - stmp.xridx (kk++) = jr; - } - if (ii == jj) - { - i++; - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - if (i < lhs_nz) - ii = ic * lhs_nr + c_lhs.ridx(i); - } - j++; - if (j < len) - { - jj = idx_i.elem (j); - jr = jj % lhs_nr; - jc = (jj - jr) / lhs_nr; - } - } - } - - for (octave_idx_type iidx = kc; iidx < lhs_nc+1; iidx++) - stmp.xcidx(iidx) = kk; - - lhs = stmp; - } - else if (rhs_nr == 1 && rhs_nc == 1) - { - RT scalar = rhs.elem (0, 0); - octave_idx_type new_nzmx = lhs_nz; - idx_i.sort (true); - len = idx_i.length (len); - - // First count the number of non-zero elements - if (scalar != RT ()) - new_nzmx += len; - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - octave_idx_type ii = idx_i.elem (i); - if (ii < lhs_len && c_lhs.elem(ii) != LT ()) - new_nzmx--; - } - - Sparse<LT> stmp (lhs_nr, lhs_nc, new_nzmx); - - octave_idx_type i = 0; - octave_idx_type ii = 0; - octave_idx_type ic = 0; - if (i < lhs_nz) - { - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - ii = ic * lhs_nr + c_lhs.ridx(i); - } - - octave_idx_type j = 0; - octave_idx_type jj = idx_i.elem (j); - octave_idx_type jr = jj % lhs_nr; - octave_idx_type jc = (jj - jr) / lhs_nr; - - octave_idx_type kk = 0; - octave_idx_type kc = 0; - - while (j < len || i < lhs_nz) - { - if (j == len || (i < lhs_nz && ii < jj)) - { - while (kc <= ic) - stmp.xcidx (kc++) = kk; - stmp.xdata (kk) = c_lhs.data (i); - stmp.xridx (kk++) = c_lhs.ridx (i); - i++; - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - if (i < lhs_nz) - ii = ic * lhs_nr + c_lhs.ridx(i); - } - else - { - while (kc <= jc) - stmp.xcidx (kc++) = kk; - if (scalar != RT ()) - { - stmp.xdata (kk) = scalar; - stmp.xridx (kk++) = jr; - } - if (ii == jj) - { - i++; - while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) - ic++; - if (i < lhs_nz) - ii = ic * lhs_nr + c_lhs.ridx(i); - } - j++; - if (j < len) - { - jj = idx_i.elem (j); - jr = jj % lhs_nr; - jc = (jj - jr) / lhs_nr; - } - } - } - - for (octave_idx_type iidx = kc; iidx < lhs_nc+1; iidx++) - stmp.xcidx(iidx) = kk; - - lhs = stmp; - } - else - { - (*current_liboctave_error_handler) + { + if (! idx_i.is_colon ()) + (*current_liboctave_warning_with_id_handler) + ("Octave:fortran-indexing", "single index used for matrix"); + + octave_idx_type lhs_len = lhs.length (); + + octave_idx_type len = idx_i.freeze (lhs_nr * lhs_nc, "matrix"); + + if (idx_i) + { + if (len == 0) + { + if (! ((rhs_nr == 1 && rhs_nc == 1) + || (rhs_nr == 0 || rhs_nc == 0))) + (*current_liboctave_error_handler) + ("A([]) = X: X must be an empty matrix or scalar"); + } + else if (len == rhs_nr * rhs_nc) + { + octave_idx_type new_nzmx = lhs_nz; + OCTAVE_LOCAL_BUFFER (octave_idx_type, rhs_idx, len); + + if (! idx_i.is_colon ()) + { + // Ok here we have to be careful with the indexing, to + // treat cases like "a([3,2,1]) = b", and still handle + // the need for strict sorting of the sparse elements. + + OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort *, sidx, + len); + OCTAVE_LOCAL_BUFFER (octave_idx_vector_sort, sidxX, + len); + + for (octave_idx_type i = 0; i < len; i++) + { + sidx[i] = &sidxX[i]; + sidx[i]->i = idx_i.elem(i); + sidx[i]->idx = i; + } + + octave_quit (); + octave_sort<octave_idx_vector_sort *> + sort (octave_idx_vector_comp); + + sort.sort (sidx, len); + + intNDArray<octave_idx_type> new_idx (dim_vector (len,1)); + + for (octave_idx_type i = 0; i < len; i++) + { + new_idx.xelem(i) = sidx[i]->i; + rhs_idx[i] = sidx[i]->idx; + } + + idx_i = idx_vector (new_idx); + } + else + for (octave_idx_type i = 0; i < len; i++) + rhs_idx[i] = i; + + // First count the number of non-zero elements + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + + octave_idx_type ii = idx_i.elem (i); + if (i < len - 1 && idx_i.elem (i + 1) == ii) + continue; + if (ii < lhs_len && c_lhs.elem(ii) != LT ()) + new_nzmx--; + if (rhs.elem(rhs_idx[i]) != RT ()) + new_nzmx++; + } + + Sparse<LT> stmp (lhs_nr, lhs_nc, new_nzmx); + + octave_idx_type i = 0; + octave_idx_type ii = 0; + octave_idx_type ic = 0; + if (i < lhs_nz) + { + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + ii = ic * lhs_nr + c_lhs.ridx(i); + } + + octave_idx_type j = 0; + octave_idx_type jj = idx_i.elem (j); + octave_idx_type jr = jj % lhs_nr; + octave_idx_type jc = (jj - jr) / lhs_nr; + + octave_idx_type kk = 0; + octave_idx_type kc = 0; + + while (j < len || i < lhs_nz) + { + if (j < len - 1 && idx_i.elem (j + 1) == jj) + { + j++; + jj = idx_i.elem (j); + jr = jj % lhs_nr; + jc = (jj - jr) / lhs_nr; + continue; + } + + if (j == len || (i < lhs_nz && ii < jj)) + { + while (kc <= ic) + stmp.xcidx (kc++) = kk; + stmp.xdata (kk) = c_lhs.data (i); + stmp.xridx (kk++) = c_lhs.ridx (i); + i++; + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + if (i < lhs_nz) + ii = ic * lhs_nr + c_lhs.ridx(i); + } + else + { + while (kc <= jc) + stmp.xcidx (kc++) = kk; + RT rtmp = rhs.elem (rhs_idx[j]); + if (rtmp != RT ()) + { + stmp.xdata (kk) = rtmp; + stmp.xridx (kk++) = jr; + } + if (ii == jj) + { + i++; + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + if (i < lhs_nz) + ii = ic * lhs_nr + c_lhs.ridx(i); + } + j++; + if (j < len) + { + jj = idx_i.elem (j); + jr = jj % lhs_nr; + jc = (jj - jr) / lhs_nr; + } + } + } + + for (octave_idx_type iidx = kc; iidx < lhs_nc+1; iidx++) + stmp.xcidx(iidx) = kk; + + lhs = stmp; + } + else if (rhs_nr == 1 && rhs_nc == 1) + { + RT scalar = rhs.elem (0, 0); + octave_idx_type new_nzmx = lhs_nz; + idx_i.sort (true); + len = idx_i.length (len); + + // First count the number of non-zero elements + if (scalar != RT ()) + new_nzmx += len; + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + octave_idx_type ii = idx_i.elem (i); + if (ii < lhs_len && c_lhs.elem(ii) != LT ()) + new_nzmx--; + } + + Sparse<LT> stmp (lhs_nr, lhs_nc, new_nzmx); + + octave_idx_type i = 0; + octave_idx_type ii = 0; + octave_idx_type ic = 0; + if (i < lhs_nz) + { + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + ii = ic * lhs_nr + c_lhs.ridx(i); + } + + octave_idx_type j = 0; + octave_idx_type jj = idx_i.elem (j); + octave_idx_type jr = jj % lhs_nr; + octave_idx_type jc = (jj - jr) / lhs_nr; + + octave_idx_type kk = 0; + octave_idx_type kc = 0; + + while (j < len || i < lhs_nz) + { + if (j == len || (i < lhs_nz && ii < jj)) + { + while (kc <= ic) + stmp.xcidx (kc++) = kk; + stmp.xdata (kk) = c_lhs.data (i); + stmp.xridx (kk++) = c_lhs.ridx (i); + i++; + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + if (i < lhs_nz) + ii = ic * lhs_nr + c_lhs.ridx(i); + } + else + { + while (kc <= jc) + stmp.xcidx (kc++) = kk; + if (scalar != RT ()) + { + stmp.xdata (kk) = scalar; + stmp.xridx (kk++) = jr; + } + if (ii == jj) + { + i++; + while (ic < lhs_nc && i >= c_lhs.cidx(ic+1)) + ic++; + if (i < lhs_nz) + ii = ic * lhs_nr + c_lhs.ridx(i); + } + j++; + if (j < len) + { + jj = idx_i.elem (j); + jr = jj % lhs_nr; + jc = (jj - jr) / lhs_nr; + } + } + } + + for (octave_idx_type iidx = kc; iidx < lhs_nc+1; iidx++) + stmp.xcidx(iidx) = kk; + + lhs = stmp; + } + else + { + (*current_liboctave_error_handler) ("A(I) = X: X must be a scalar or a matrix with the same size as I"); - retval = 0; - } - } - // idx_vector::freeze() printed an error message for us. - } + retval = 0; + } + } + // idx_vector::freeze() printed an error message for us. + } } else { (*current_liboctave_error_handler) - ("invalid number of indices for matrix expression"); + ("invalid number of indices for matrix expression"); retval = 0; }
--- a/liboctave/SparseCmplxCHOL.cc +++ b/liboctave/SparseCmplxCHOL.cc @@ -50,18 +50,18 @@ SparseComplexMatrix rinv; if (typ == MatrixType::Upper) - { - rinv = r.inverse(mattype, info, rcond, true, false); - retval = rinv.transpose() * rinv; - } + { + rinv = r.inverse(mattype, info, rcond, true, false); + retval = rinv.transpose() * rinv; + } else if (typ == MatrixType::Lower) - { - rinv = r.transpose().inverse(mattype, info, rcond, true, false); - retval = rinv.transpose() * rinv; - } + { + rinv = r.transpose().inverse(mattype, info, rcond, true, false); + retval = rinv.transpose() * rinv; + } else - (*current_liboctave_error_handler) - ("spchol2inv requires triangular matrix"); + (*current_liboctave_error_handler) + ("spchol2inv requires triangular matrix"); } else (*current_liboctave_error_handler) ("spchol2inv requires square matrix");
--- a/liboctave/SparseCmplxLU.cc +++ b/liboctave/SparseCmplxLU.cc @@ -43,7 +43,7 @@ #include "oct-sparse.h" SparseComplexLU::SparseComplexLU (const SparseComplexMatrix& a, - const Matrix& piv_thres, bool scale) + const Matrix& piv_thres, bool scale) { #ifdef HAVE_UMFPACK octave_idx_type nr = a.rows (); @@ -61,20 +61,20 @@ { tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; } else { tmp = octave_sparse_params::get_key ("piv_tol"); if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; tmp = octave_sparse_params::get_key ("sym_tol"); if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; } // Set whether we are allowed to modify Q or not @@ -95,21 +95,21 @@ const Complex *Ax = a.data (); UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, 1, control); + reinterpret_cast<const double *> (Ax), + 0, 1, control); void *Symbolic; Matrix Info (1, UMFPACK_INFO); double *info = Info.fortran_vec (); int status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, 0, - &Symbolic, control, info); + reinterpret_cast<const double *> (Ax), + 0, 0, + &Symbolic, control, info); if (status < 0) { (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU symbolic factorization failed"); + ("SparseComplexLU::SparseComplexLU symbolic factorization failed"); UMFPACK_ZNAME (report_status) (control, status); UMFPACK_ZNAME (report_info) (control, info); @@ -122,121 +122,121 @@ void *Numeric; status = UMFPACK_ZNAME (numeric) (Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, Symbolic, &Numeric, control, - info); + reinterpret_cast<const double *> (Ax), + 0, Symbolic, &Numeric, control, + info); UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; cond = Info (UMFPACK_RCOND); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU numeric factorization failed"); + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU numeric factorization failed"); - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); - UMFPACK_ZNAME (free_numeric) (&Numeric); - } + UMFPACK_ZNAME (free_numeric) (&Numeric); + } else - { - UMFPACK_ZNAME (report_numeric) (Numeric, control); + { + UMFPACK_ZNAME (report_numeric) (Numeric, control); - octave_idx_type lnz, unz, ignore1, ignore2, ignore3; - status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz, &ignore1, - &ignore2, &ignore3, Numeric) ; - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); + octave_idx_type lnz, unz, ignore1, ignore2, ignore3; + status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz, &ignore1, + &ignore2, &ignore3, Numeric) ; + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - { - octave_idx_type n_inner = (nr < nc ? nr : nc); + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + { + octave_idx_type n_inner = (nr < nc ? nr : nc); - if (lnz < 1) - Lfact = SparseComplexMatrix (n_inner, nr, - static_cast<octave_idx_type> (1)); - else - Lfact = SparseComplexMatrix (n_inner, nr, lnz); + if (lnz < 1) + Lfact = SparseComplexMatrix (n_inner, nr, + static_cast<octave_idx_type> (1)); + else + Lfact = SparseComplexMatrix (n_inner, nr, lnz); - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - Complex *Ltx = Lfact.data (); + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + Complex *Ltx = Lfact.data (); - if (unz < 1) - Ufact = SparseComplexMatrix (n_inner, nc, - static_cast<octave_idx_type> (1)); - else - Ufact = SparseComplexMatrix (n_inner, nc, unz); + if (unz < 1) + Ufact = SparseComplexMatrix (n_inner, nc, + static_cast<octave_idx_type> (1)); + else + Ufact = SparseComplexMatrix (n_inner, nc, unz); - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - Complex *Ux = Ufact.data (); - - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + Complex *Ux = Ufact.data (); + + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); - P.resize (nr); - octave_idx_type *p = P.fortran_vec (); + P.resize (nr); + octave_idx_type *p = P.fortran_vec (); - Q.resize (nc); - octave_idx_type *q = Q.fortran_vec (); + Q.resize (nc); + octave_idx_type *q = Q.fortran_vec (); - octave_idx_type do_recip; - status = UMFPACK_ZNAME (get_numeric) (Ltp, Ltj, - reinterpret_cast<double *> (Ltx), - 0, Up, Uj, - reinterpret_cast <double *> (Ux), - 0, p, q, 0, 0, - &do_recip, Rx, Numeric); + octave_idx_type do_recip; + status = UMFPACK_ZNAME (get_numeric) (Ltp, Ltj, + reinterpret_cast<double *> (Ltx), + 0, Up, Uj, + reinterpret_cast <double *> (Ux), + 0, p, q, 0, 0, + &do_recip, Rx, Numeric); - UMFPACK_ZNAME (free_numeric) (&Numeric) ; + UMFPACK_ZNAME (free_numeric) (&Numeric) ; - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); - UMFPACK_ZNAME (report_status) (control, status); - } - else - { - Lfact = Lfact.transpose (); + UMFPACK_ZNAME (report_status) (control, status); + } + else + { + Lfact = Lfact.transpose (); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; - UMFPACK_ZNAME (report_matrix) (nr, n_inner, - Lfact.cidx (), Lfact.ridx (), - reinterpret_cast<double *> (Lfact.data()), - 0, 1, control); + UMFPACK_ZNAME (report_matrix) (nr, n_inner, + Lfact.cidx (), Lfact.ridx (), + reinterpret_cast<double *> (Lfact.data()), + 0, 1, control); - UMFPACK_ZNAME (report_matrix) (n_inner, nc, - Ufact.cidx (), Ufact.ridx (), - reinterpret_cast<double *> (Ufact.data()), - 0, 1, control); - UMFPACK_ZNAME (report_perm) (nr, p, control); - UMFPACK_ZNAME (report_perm) (nc, q, control); - } + UMFPACK_ZNAME (report_matrix) (n_inner, nc, + Ufact.cidx (), Ufact.ridx (), + reinterpret_cast<double *> (Ufact.data()), + 0, 1, control); + UMFPACK_ZNAME (report_perm) (nr, p, control); + UMFPACK_ZNAME (report_perm) (nc, q, control); + } - UMFPACK_ZNAME (report_info) (control, info); - } - } + UMFPACK_ZNAME (report_info) (control, info); + } + } } #else (*current_liboctave_error_handler) ("UMFPACK not installed"); @@ -244,10 +244,10 @@ } SparseComplexLU::SparseComplexLU (const SparseComplexMatrix& a, - const ColumnVector& Qinit, - const Matrix& piv_thres, bool scale, - bool FixedQ, double droptol, - bool milu, bool udiag) + const ColumnVector& Qinit, + const Matrix& piv_thres, bool scale, + bool FixedQ, double droptol, + bool milu, bool udiag) { #ifdef HAVE_UMFPACK if (milu) @@ -265,45 +265,45 @@ double tmp = octave_sparse_params::get_key ("spumoni"); if (!xisnan (tmp)) - Control (UMFPACK_PRL) = tmp; + Control (UMFPACK_PRL) = tmp; if (piv_thres.nelem() == 2) - { - tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); - if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); - if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } + { + tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); + if (!xisnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); + if (!xisnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } else - { - tmp = octave_sparse_params::get_key ("piv_tol"); - if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + { + tmp = octave_sparse_params::get_key ("piv_tol"); + if (!xisnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - tmp = octave_sparse_params::get_key ("sym_tol"); - if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } + tmp = octave_sparse_params::get_key ("sym_tol"); + if (!xisnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } if (droptol >= 0.) - Control (UMFPACK_DROPTOL) = droptol; + Control (UMFPACK_DROPTOL) = droptol; // Set whether we are allowed to modify Q or not if (FixedQ) - Control (UMFPACK_FIXQ) = 1.0; + Control (UMFPACK_FIXQ) = 1.0; else - { - tmp = octave_sparse_params::get_key ("autoamd"); - if (!xisnan (tmp)) - Control (UMFPACK_FIXQ) = tmp; - } + { + tmp = octave_sparse_params::get_key ("autoamd"); + if (!xisnan (tmp)) + Control (UMFPACK_FIXQ) = tmp; + } // Turn-off UMFPACK scaling for LU if (scale) - Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; + Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; else - Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; + Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; UMFPACK_ZNAME (report_control) (control); @@ -312,8 +312,8 @@ const Complex *Ax = a.data (); UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), 0, - 1, control); + reinterpret_cast<const double *> (Ax), 0, + 1, control); void *Symbolic; Matrix Info (1, UMFPACK_INFO); @@ -323,155 +323,155 @@ // Null loop so that qinit is imediately deallocated when not // needed do { - OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); - for (octave_idx_type i = 0; i < nc; i++) - qinit [i] = static_cast<octave_idx_type> (Qinit (i)); + for (octave_idx_type i = 0; i < nc; i++) + qinit [i] = static_cast<octave_idx_type> (Qinit (i)); - status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai, - reinterpret_cast<const double *> (Ax), - 0, qinit, &Symbolic, control, - info); + status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai, + reinterpret_cast<const double *> (Ax), + 0, qinit, &Symbolic, control, + info); } while (0); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU symbolic factorization failed"); + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU symbolic factorization failed"); - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); - UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; - } + UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; + } else - { - UMFPACK_ZNAME (report_symbolic) (Symbolic, control); + { + UMFPACK_ZNAME (report_symbolic) (Symbolic, control); - void *Numeric; - status = UMFPACK_ZNAME (numeric) (Ap, Ai, - reinterpret_cast<const double *> (Ax), 0, - Symbolic, &Numeric, control, info) ; - UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; + void *Numeric; + status = UMFPACK_ZNAME (numeric) (Ap, Ai, + reinterpret_cast<const double *> (Ax), 0, + Symbolic, &Numeric, control, info) ; + UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; - cond = Info (UMFPACK_RCOND); + cond = Info (UMFPACK_RCOND); - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU numeric factorization failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU numeric factorization failed"); - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - { - UMFPACK_ZNAME (report_numeric) (Numeric, control); + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + { + UMFPACK_ZNAME (report_numeric) (Numeric, control); - octave_idx_type lnz, unz, ignore1, ignore2, ignore3; - status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz, - &ignore1, &ignore2, &ignore3, Numeric); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); + octave_idx_type lnz, unz, ignore1, ignore2, ignore3; + status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz, + &ignore1, &ignore2, &ignore3, Numeric); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); - UMFPACK_ZNAME (report_status) (control, status); - UMFPACK_ZNAME (report_info) (control, info); + UMFPACK_ZNAME (report_status) (control, status); + UMFPACK_ZNAME (report_info) (control, info); - UMFPACK_ZNAME (free_numeric) (&Numeric); - } - else - { - octave_idx_type n_inner = (nr < nc ? nr : nc); + UMFPACK_ZNAME (free_numeric) (&Numeric); + } + else + { + octave_idx_type n_inner = (nr < nc ? nr : nc); - if (lnz < 1) - Lfact = SparseComplexMatrix (n_inner, nr, - static_cast<octave_idx_type> (1)); - else - Lfact = SparseComplexMatrix (n_inner, nr, lnz); + if (lnz < 1) + Lfact = SparseComplexMatrix (n_inner, nr, + static_cast<octave_idx_type> (1)); + else + Lfact = SparseComplexMatrix (n_inner, nr, lnz); - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - Complex *Ltx = Lfact.data (); + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + Complex *Ltx = Lfact.data (); - if (unz < 1) - Ufact = SparseComplexMatrix (n_inner, nc, - static_cast<octave_idx_type> (1)); - else - Ufact = SparseComplexMatrix (n_inner, nc, unz); + if (unz < 1) + Ufact = SparseComplexMatrix (n_inner, nc, + static_cast<octave_idx_type> (1)); + else + Ufact = SparseComplexMatrix (n_inner, nc, unz); - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - Complex *Ux = Ufact.data (); - - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + Complex *Ux = Ufact.data (); + + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); - P.resize (nr); - octave_idx_type *p = P.fortran_vec (); + P.resize (nr); + octave_idx_type *p = P.fortran_vec (); - Q.resize (nc); - octave_idx_type *q = Q.fortran_vec (); + Q.resize (nc); + octave_idx_type *q = Q.fortran_vec (); - octave_idx_type do_recip; - status = - UMFPACK_ZNAME (get_numeric) (Ltp, Ltj, - reinterpret_cast<double *> (Ltx), - 0, Up, Uj, - reinterpret_cast<double *> (Ux), - 0, p, q, 0, 0, - &do_recip, Rx, Numeric) ; + octave_idx_type do_recip; + status = + UMFPACK_ZNAME (get_numeric) (Ltp, Ltj, + reinterpret_cast<double *> (Ltx), + 0, Up, Uj, + reinterpret_cast<double *> (Ux), + 0, p, q, 0, 0, + &do_recip, Rx, Numeric) ; - UMFPACK_ZNAME (free_numeric) (&Numeric) ; + UMFPACK_ZNAME (free_numeric) (&Numeric) ; - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseComplexLU::SparseComplexLU extracting LU factors failed"); - UMFPACK_ZNAME (report_status) (control, status); - } - else - { - Lfact = Lfact.transpose (); + UMFPACK_ZNAME (report_status) (control, status); + } + else + { + Lfact = Lfact.transpose (); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; - UMFPACK_ZNAME (report_matrix) (nr, n_inner, - Lfact.cidx (), - Lfact.ridx (), - reinterpret_cast<double *> (Lfact.data()), - 0, 1, control); + UMFPACK_ZNAME (report_matrix) (nr, n_inner, + Lfact.cidx (), + Lfact.ridx (), + reinterpret_cast<double *> (Lfact.data()), + 0, 1, control); - UMFPACK_ZNAME (report_matrix) (n_inner, nc, - Ufact.cidx (), - Ufact.ridx (), - reinterpret_cast<double *> (Ufact.data()), - 0, 1, control); - UMFPACK_ZNAME (report_perm) (nr, p, control); - UMFPACK_ZNAME (report_perm) (nc, q, control); - } + UMFPACK_ZNAME (report_matrix) (n_inner, nc, + Ufact.cidx (), + Ufact.ridx (), + reinterpret_cast<double *> (Ufact.data()), + 0, 1, control); + UMFPACK_ZNAME (report_perm) (nr, p, control); + UMFPACK_ZNAME (report_perm) (nc, q, control); + } - UMFPACK_ZNAME (report_info) (control, info); - } - } - } + UMFPACK_ZNAME (report_info) (control, info); + } + } + } if (udiag) - (*current_liboctave_error_handler) - ("Option udiag of incomplete LU not implemented"); + (*current_liboctave_error_handler) + ("Option udiag of incomplete LU not implemented"); } #else (*current_liboctave_error_handler) ("UMFPACK not installed");
--- a/liboctave/SparseCmplxQR.cc +++ b/liboctave/SparseCmplxQR.cc @@ -62,7 +62,7 @@ A.p = const_cast<octave_idx_type *>(a.cidx ()); A.i = const_cast<octave_idx_type *>(a.ridx ()); A.x = const_cast<cs_complex_t *>(reinterpret_cast<const cs_complex_t *> - (a.data ())); + (a.data ())); A.nz = -1; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) @@ -204,29 +204,29 @@ { OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) - { - octave_quit (); - volatile octave_idx_type nm = (nr < nc ? nr : nc); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + octave_quit (); + volatile octave_idx_type nm = (nr < nc ? nr : nc); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (S->pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf), b_nr); + CXSPARSE_ZNAME (_ipvec) + (S->pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf), b_nr); #else - CXSPARSE_ZNAME (_ipvec) - (b_nr, S->Pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf)); + CXSPARSE_ZNAME (_ipvec) + (b_nr, S->Pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) - (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - for (octave_idx_type i = 0; i < b_nr; i++) - vec[i+idx] = buf[i]; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) + (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + for (octave_idx_type i = 0; i < b_nr; i++) + vec[i+idx] = buf[i]; + } } return ret; #else @@ -250,34 +250,34 @@ { OCTAVE_C99_COMPLEX (bvec, nr); for (octave_idx_type i = 0; i < nr; i++) - bvec[i] = OCTAVE_C99_ZERO; + bvec[i] = OCTAVE_C99_ZERO; OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) - { - octave_quit (); - bvec[j] = OCTAVE_C99_ONE; - volatile octave_idx_type nm = (nr < nc ? nr : nc); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + octave_quit (); + bvec[j] = OCTAVE_C99_ONE; + volatile octave_idx_type nm = (nr < nc ? nr : nc); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (S->pinv, bvec, reinterpret_cast<cs_complex_t *>(buf), nr); + CXSPARSE_ZNAME (_ipvec) + (S->pinv, bvec, reinterpret_cast<cs_complex_t *>(buf), nr); #else - CXSPARSE_ZNAME (_ipvec) - (nr, S->Pinv, bvec, reinterpret_cast<cs_complex_t *>(buf)); + CXSPARSE_ZNAME (_ipvec) + (nr, S->Pinv, bvec, reinterpret_cast<cs_complex_t *>(buf)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) - (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - for (octave_idx_type i = 0; i < nr; i++) - vec[i+idx] = buf[i]; - bvec[j] = OCTAVE_C99_ZERO; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) + (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + for (octave_idx_type i = 0; i < nr; i++) + vec[i+idx] = buf[i]; + bvec[j] = OCTAVE_C99_ZERO; + } } return ret.hermitian (); #else @@ -305,44 +305,44 @@ { SparseComplexQR q (a, 2); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); cs_complex_t *vec = reinterpret_cast<cs_complex_t *> - (x.fortran_vec()); + (x.fortran_vec()); OCTAVE_C99_COMPLEX (buf, q.S()->m2); OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); 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 < q.S()->m2; j++) - buf[j] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_ipvec) + (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_ipvec) - (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_ipvec) + (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); + CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); #else - CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); + CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } else @@ -350,60 +350,60 @@ SparseComplexMatrix at = a.hermitian(); SparseComplexQR q (at, 2); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); cs_complex_t *vec = reinterpret_cast<cs_complex_t *> - (x.fortran_vec()); + (x.fortran_vec()); 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); #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) OCTAVE_LOCAL_BUFFER (double, B, nr); for (octave_idx_type i = 0; i < nr; i++) - B[i] = q.N()->B [i]; + B[i] = q.N()->B [i]; #else 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]); + B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); #endif 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] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) - (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_pvec) + (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_pvec) - (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_pvec) + (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) - CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); + CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); #else - CXSPARSE_ZNAME (_happly) - (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); + CXSPARSE_ZNAME (_happly) + (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); + CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); #else - CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); + CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } @@ -434,7 +434,7 @@ { SparseComplexQR q (a, 2); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -442,58 +442,58 @@ OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); OCTAVE_C99_COMPLEX (buf, q.S()->m2); 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 < q.S()->m2; j++) - buf[j] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_ipvec) + (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_ipvec) - (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_ipvec) + (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (q.S()->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + CXSPARSE_ZNAME (_ipvec) + (q.S()->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); #else - CXSPARSE_ZNAME (_ipvec) - (nc, q.S()->Q, buf, reinterpret_cast<cs_complex_t *>(Xx)); + CXSPARSE_ZNAME (_ipvec) + (nc, q.S()->Q, buf, reinterpret_cast<cs_complex_t *>(Xx)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } else @@ -501,7 +501,7 @@ SparseComplexMatrix at = a.hermitian(); SparseComplexQR q (at, 2); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -513,70 +513,70 @@ #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) OCTAVE_LOCAL_BUFFER (double, B, nr); for (octave_idx_type i = 0; i < nr; i++) - B[i] = q.N()->B [i]; + B[i] = q.N()->B [i]; #else 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]); + B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); #endif 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] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) - (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_pvec) + (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_pvec) - (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_pvec) + (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) - CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); + CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); #else - CXSPARSE_ZNAME (_happly) - (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); + CXSPARSE_ZNAME (_happly) + (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) - (q.S()->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + CXSPARSE_ZNAME (_pvec) + (q.S()->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); #else - CXSPARSE_ZNAME (_pvec) - (nc, q.S()->Pinv, buf, reinterpret_cast<cs_complex_t *>(Xx)); + CXSPARSE_ZNAME (_pvec) + (nc, q.S()->Pinv, buf, reinterpret_cast<cs_complex_t *>(Xx)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } @@ -609,40 +609,40 @@ { SparseComplexQR q (a, 2); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); cs_complex_t *vec = reinterpret_cast<cs_complex_t *> - (x.fortran_vec()); + (x.fortran_vec()); OCTAVE_C99_COMPLEX (buf, q.S()->m2); 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 < q.S()->m2; j++) - buf[j] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); + CXSPARSE_ZNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); #else - CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); + CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); + CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); #else - CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); + CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } else @@ -650,55 +650,55 @@ SparseComplexMatrix at = a.hermitian(); SparseComplexQR q (at, 2); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); cs_complex_t *vec = reinterpret_cast<cs_complex_t *> - (x.fortran_vec()); + (x.fortran_vec()); volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); OCTAVE_C99_COMPLEX (buf, nbuf); #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) OCTAVE_LOCAL_BUFFER (double, B, nr); for (octave_idx_type i = 0; i < nr; i++) - B[i] = q.N()->B [i]; + B[i] = q.N()->B [i]; #else 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]); + B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); #endif 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] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); + CXSPARSE_ZNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); #else - CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); + CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); #endif - CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) - CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); + CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); #else - CXSPARSE_ZNAME (_happly) - (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); + CXSPARSE_ZNAME (_happly) + (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); + CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); #else - CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); + CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } @@ -729,7 +729,7 @@ { SparseComplexQR q (a, 2); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -737,58 +737,58 @@ OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); OCTAVE_C99_COMPLEX (buf, q.S()->m2); 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 < q.S()->m2; j++) - buf[j] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_ipvec) + (q.S()->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_ipvec) - (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_ipvec) + (nr, q.S()->Pinv, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_ipvec) - (q.S()->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + CXSPARSE_ZNAME (_ipvec) + (q.S()->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); #else - CXSPARSE_ZNAME (_ipvec) - (nc, q.S()->Q, buf, reinterpret_cast<cs_complex_t *>(Xx)); + CXSPARSE_ZNAME (_ipvec) + (nc, q.S()->Q, buf, reinterpret_cast<cs_complex_t *>(Xx)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } else @@ -796,7 +796,7 @@ SparseComplexMatrix at = a.hermitian(); SparseComplexQR q (at, 2); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -807,70 +807,70 @@ #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) OCTAVE_LOCAL_BUFFER (double, B, nr); for (octave_idx_type i = 0; i < nr; i++) - B[i] = q.N()->B [i]; + B[i] = q.N()->B [i]; #else 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]); + B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); #endif 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] = OCTAVE_C99_ZERO; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) - (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_pvec) + (q.S()->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); #else - CXSPARSE_ZNAME (_pvec) - (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); + CXSPARSE_ZNAME (_pvec) + (nr, q.S()->Q, reinterpret_cast<cs_complex_t *>(Xx), buf); #endif - CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (((CS_VER == 2) && (CS_SUBVER >= 2)) || (CS_VER > 2)) - CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); + CXSPARSE_ZNAME (_happly) (q.N()->L, j, B[j], buf); #else - CXSPARSE_ZNAME (_happly) - (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); + CXSPARSE_ZNAME (_happly) + (q.N()->L, j, reinterpret_cast<cs_complex_t *>(B)[j], buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_ZNAME (_pvec) - (q.S()->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + CXSPARSE_ZNAME (_pvec) + (q.S()->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); #else - CXSPARSE_ZNAME (_pvec) - (nc, q.S()->Pinv, buf, reinterpret_cast<cs_complex_t *>(Xx)); + CXSPARSE_ZNAME (_pvec) + (nc, q.S()->Pinv, buf, reinterpret_cast<cs_complex_t *>(Xx)); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } @@ -883,14 +883,14 @@ ComplexMatrix qrsolve (const SparseComplexMatrix &a, const MArray2<double> &b, - octave_idx_type &info) + octave_idx_type &info) { return qrsolve (a, Matrix (b), info); } ComplexMatrix qrsolve (const SparseComplexMatrix &a, const MArray2<Complex> &b, - octave_idx_type &info) + octave_idx_type &info) { return qrsolve (a, ComplexMatrix (b), info); }
--- a/liboctave/SparseQR.cc +++ b/liboctave/SparseQR.cc @@ -185,29 +185,29 @@ { OCTAVE_LOCAL_BUFFER (double, buf, S->m2); 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; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + idx, buf, b_nr); + CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + idx, buf, b_nr); #else - CXSPARSE_DNAME (_ipvec) (b_nr, S->Pinv, bvec + idx, buf); + CXSPARSE_DNAME (_ipvec) (b_nr, S->Pinv, bvec + idx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - for (octave_idx_type i = 0; i < b_nr; i++) - vec[i+idx] = buf[i]; - } + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + for (octave_idx_type i = 0; i < b_nr; i++) + vec[i+idx] = buf[i]; + } } return ret; #else @@ -231,34 +231,34 @@ { OCTAVE_LOCAL_BUFFER (double, bvec, nr + 1); for (octave_idx_type i = 0; i < nr; i++) - bvec[i] = 0.; + bvec[i] = 0.; OCTAVE_LOCAL_BUFFER (double, buf, S->m2); for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) - { - octave_quit (); - bvec[j] = 1.0; - 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; + { + octave_quit (); + bvec[j] = 1.0; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (S->pinv, bvec, buf, nr); + CXSPARSE_DNAME (_ipvec) (S->pinv, bvec, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, S->Pinv, bvec, buf); + CXSPARSE_DNAME (_ipvec) (nr, S->Pinv, bvec, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - for (octave_idx_type i = 0; i < nr; i++) - vec[i+idx] = buf[i]; - bvec[j] = 0.0; - } + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + for (octave_idx_type i = 0; i < nr; i++) + vec[i+idx] = buf[i]; + bvec[j] = 0.0; + } } return ret.transpose (); #else @@ -287,39 +287,39 @@ { SparseQR q (a, 3); if (! q.ok ()) - return Matrix(); + return Matrix(); x.resize(nc, b_nc); double *vec = x.fortran_vec(); OCTAVE_LOCAL_BUFFER (double, buf, q.S()->m2); 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 < q.S()->m2; j++) - buf[j] = 0.; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } else @@ -327,40 +327,40 @@ SparseMatrix at = a.hermitian(); SparseQR q (at, 3); if (! q.ok ()) - return Matrix(); + return Matrix(); x.resize(nc, b_nc); double *vec = x.fortran_vec(); 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; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } info = 0; } @@ -391,7 +391,7 @@ { SparseQR q (a, 3); if (! q.ok ()) - return SparseMatrix(); + return SparseMatrix(); x = SparseMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -399,54 +399,54 @@ OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); OCTAVE_LOCAL_BUFFER (double, buf, q.S()->m2); 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 < q.S()->m2; j++) - buf[j] = 0.; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + double tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } else @@ -454,7 +454,7 @@ SparseMatrix at = a.hermitian(); SparseQR q (at, 3); if (! q.ok ()) - return SparseMatrix(); + return SparseMatrix(); x = SparseMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -463,54 +463,54 @@ OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); 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; + { + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = Xx[j]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + double tmp = Xx[j]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } @@ -541,70 +541,70 @@ { SparseQR q (a, 3); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); Complex *vec = x.fortran_vec(); 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, q.S()->m2); 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++) - { - Complex c = b.xelem (j,i); - 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; + { + octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); #endif - for (octave_idx_type j = nr; j < q.S()->m2; j++) - buf[j] = 0.; + for (octave_idx_type j = nr; j < q.S()->m2; j++) + buf[j] = 0.; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xz, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xz, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xz, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xz, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xz); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xz); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - vec[j+idx] = Complex (Xx[j], Xz[j]); - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = 0; j < nc; j++) + vec[j+idx] = Complex (Xx[j], Xz[j]); + } info = 0; } else @@ -612,7 +612,7 @@ SparseMatrix at = a.hermitian(); SparseQR q (at, 3); if (! q.ok ()) - return ComplexMatrix(); + return ComplexMatrix(); x.resize(nc, b_nc); Complex *vec = x.fortran_vec(); volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); @@ -620,65 +620,65 @@ OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); 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++) - { - Complex c = b.xelem (j,i); - 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; + { + octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, Xz, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, Xz, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xz, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xz, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xz); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xz); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - vec[j+idx] = Complex (Xx[j], Xz[j]); - } + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = 0; j < nc; j++) + vec[j+idx] = Complex (Xx[j], Xz[j]); + } info = 0; } @@ -709,7 +709,7 @@ { SparseQR q (a, 3); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -718,82 +718,82 @@ OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); OCTAVE_LOCAL_BUFFER (double, buf, q.S()->m2); 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++) - { - Complex c = b.xelem (j,i); - 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; + { + octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xx, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xx, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xx, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xx); #endif - 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; + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xz, buf, nr); + CXSPARSE_DNAME (_ipvec) (q.S()->pinv, Xz, buf, nr); #else - CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); + CXSPARSE_DNAME (_ipvec) (nr, q.S()->Pinv, Xz, buf); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (q.N()->U, buf); #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xz, nc); + CXSPARSE_DNAME (_ipvec) (q.S()->q, buf, Xz, nc); #else - CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xz); + CXSPARSE_DNAME (_ipvec) (nc, q.S()->Q, buf, Xz); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Complex (Xx[j], Xz[j]); - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Complex (Xx[j], Xz[j]); + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } else @@ -801,7 +801,7 @@ SparseMatrix at = a.hermitian(); SparseQR q (at, 3); if (! q.ok ()) - return SparseComplexMatrix(); + return SparseComplexMatrix(); x = SparseComplexMatrix (nc, b_nc, b.nzmax()); x.xcidx(0) = 0; x_nz = b.nzmax(); @@ -811,82 +811,82 @@ OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); 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++) - { - Complex c = b.xelem (j,i); - 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; + { + octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + 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; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, Xx, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xx, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xx, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xx); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->q, Xz, buf, nr); + CXSPARSE_DNAME (_pvec) (q.S()->q, Xz, buf, nr); #else - CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); + CXSPARSE_DNAME (_pvec) (nr, q.S()->Q, Xz, buf); #endif - CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_utsolve) (q.N()->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; #if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xz, nc); + CXSPARSE_DNAME (_pvec) (q.S()->pinv, buf, Xz, nc); #else - CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xz); + CXSPARSE_DNAME (_pvec) (nc, q.S()->Pinv, buf, Xz); #endif - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Complex (Xx[j], Xz[j]); - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - x.xdata(ii) = tmp; - x.xridx(ii++) = j; - } - } - x.xcidx(i+1) = ii; - } + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Complex (Xx[j], Xz[j]); + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + x.xdata(ii) = tmp; + x.xridx(ii++) = j; + } + } + x.xcidx(i+1) = ii; + } info = 0; } @@ -899,14 +899,14 @@ Matrix qrsolve(const SparseMatrix &a, const MArray2<double> &b, - octave_idx_type &info) + octave_idx_type &info) { return qrsolve (a, Matrix (b), info); } ComplexMatrix qrsolve(const SparseMatrix &a, const MArray2<Complex> &b, - octave_idx_type &info) + octave_idx_type &info) { return qrsolve (a, ComplexMatrix (b), info); }
--- a/liboctave/SparsedbleCHOL.cc +++ b/liboctave/SparsedbleCHOL.cc @@ -50,18 +50,18 @@ SparseMatrix rinv; if (typ == MatrixType::Upper) - { - rinv = r.inverse(mattype, info, rcond, true, false); - retval = rinv.transpose() * rinv; - } + { + rinv = r.inverse(mattype, info, rcond, true, false); + retval = rinv.transpose() * rinv; + } else if (typ == MatrixType::Lower) - { - rinv = r.transpose().inverse(mattype, info, rcond, true, false); - retval = rinv.transpose() * rinv; - } + { + rinv = r.transpose().inverse(mattype, info, rcond, true, false); + retval = rinv.transpose() * rinv; + } else - (*current_liboctave_error_handler) - ("spchol2inv requires triangular matrix"); + (*current_liboctave_error_handler) + ("spchol2inv requires triangular matrix"); } else (*current_liboctave_error_handler) ("spchol2inv requires square matrix");
--- a/liboctave/SparsedbleLU.cc +++ b/liboctave/SparsedbleLU.cc @@ -61,20 +61,20 @@ { tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; } else { tmp = octave_sparse_params::get_key ("piv_tol"); if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; tmp = octave_sparse_params::get_key ("sym_tol"); if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; } // Set whether we are allowed to modify Q or not @@ -99,12 +99,12 @@ Matrix Info (1, UMFPACK_INFO); double *info = Info.fortran_vec (); int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, 0, - &Symbolic, control, info); + &Symbolic, control, info); if (status < 0) { (*current_liboctave_error_handler) - ("SparseLU::SparseLU symbolic factorization failed"); + ("SparseLU::SparseLU symbolic factorization failed"); UMFPACK_DNAME (report_status) (control, status); UMFPACK_DNAME (report_info) (control, info); @@ -117,114 +117,114 @@ void *Numeric; status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, - &Numeric, control, info) ; + &Numeric, control, info) ; UMFPACK_DNAME (free_symbolic) (&Symbolic) ; cond = Info (UMFPACK_RCOND); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU numeric factorization failed"); + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU numeric factorization failed"); - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); - UMFPACK_DNAME (free_numeric) (&Numeric); - } + UMFPACK_DNAME (free_numeric) (&Numeric); + } else - { - UMFPACK_DNAME (report_numeric) (Numeric, control); + { + UMFPACK_DNAME (report_numeric) (Numeric, control); - octave_idx_type lnz, unz, ignore1, ignore2, ignore3; - status = UMFPACK_DNAME (get_lunz) (&lnz, &unz, &ignore1, - &ignore2, &ignore3, Numeric) ; - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU extracting LU factors failed"); + octave_idx_type lnz, unz, ignore1, ignore2, ignore3; + status = UMFPACK_DNAME (get_lunz) (&lnz, &unz, &ignore1, + &ignore2, &ignore3, Numeric) ; + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU extracting LU factors failed"); - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); - UMFPACK_DNAME (free_numeric) (&Numeric); - } - else - { - octave_idx_type n_inner = (nr < nc ? nr : nc); + UMFPACK_DNAME (free_numeric) (&Numeric); + } + else + { + octave_idx_type n_inner = (nr < nc ? nr : nc); - if (lnz < 1) - Lfact = SparseMatrix (n_inner, nr, - static_cast<octave_idx_type> (1)); - else - Lfact = SparseMatrix (n_inner, nr, lnz); + if (lnz < 1) + Lfact = SparseMatrix (n_inner, nr, + static_cast<octave_idx_type> (1)); + else + Lfact = SparseMatrix (n_inner, nr, lnz); - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - double *Ltx = Lfact.data (); + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + double *Ltx = Lfact.data (); - if (unz < 1) - Ufact = SparseMatrix (n_inner, nc, - static_cast<octave_idx_type> (1)); - else - Ufact = SparseMatrix (n_inner, nc, unz); + if (unz < 1) + Ufact = SparseMatrix (n_inner, nc, + static_cast<octave_idx_type> (1)); + else + Ufact = SparseMatrix (n_inner, nc, unz); - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - double *Ux = Ufact.data (); + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + double *Ux = Ufact.data (); - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); - P.resize (nr); - octave_idx_type *p = P.fortran_vec (); + P.resize (nr); + octave_idx_type *p = P.fortran_vec (); - Q.resize (nc); - octave_idx_type *q = Q.fortran_vec (); + Q.resize (nc); + octave_idx_type *q = Q.fortran_vec (); - octave_idx_type do_recip; - status = UMFPACK_DNAME (get_numeric) (Ltp, Ltj, Ltx, - Up, Uj, Ux, p, q, 0, - &do_recip, Rx, - Numeric) ; + octave_idx_type do_recip; + status = UMFPACK_DNAME (get_numeric) (Ltp, Ltj, Ltx, + Up, Uj, Ux, p, q, 0, + &do_recip, Rx, + Numeric) ; - UMFPACK_DNAME (free_numeric) (&Numeric) ; + UMFPACK_DNAME (free_numeric) (&Numeric) ; - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU extracting LU factors failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU extracting LU factors failed"); - UMFPACK_DNAME (report_status) (control, status); - } - else - { - Lfact = Lfact.transpose (); + UMFPACK_DNAME (report_status) (control, status); + } + else + { + Lfact = Lfact.transpose (); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; - UMFPACK_DNAME (report_matrix) (nr, n_inner, - Lfact.cidx (), Lfact.ridx (), - Lfact.data (), 1, control); - UMFPACK_DNAME (report_matrix) (n_inner, nc, - Ufact.cidx (), Ufact.ridx (), - Ufact.data (), 1, control); - UMFPACK_DNAME (report_perm) (nr, p, control); - UMFPACK_DNAME (report_perm) (nc, q, control); - } + UMFPACK_DNAME (report_matrix) (nr, n_inner, + Lfact.cidx (), Lfact.ridx (), + Lfact.data (), 1, control); + UMFPACK_DNAME (report_matrix) (n_inner, nc, + Ufact.cidx (), Ufact.ridx (), + Ufact.data (), 1, control); + UMFPACK_DNAME (report_perm) (nr, p, control); + UMFPACK_DNAME (report_perm) (nc, q, control); + } - UMFPACK_DNAME (report_info) (control, info); - } - } + UMFPACK_DNAME (report_info) (control, info); + } + } } #else (*current_liboctave_error_handler) ("UMFPACK not installed"); @@ -232,8 +232,8 @@ } SparseLU::SparseLU (const SparseMatrix& a, const ColumnVector& Qinit, - const Matrix& piv_thres, bool scale, bool FixedQ, - double droptol, bool milu, bool udiag) + const Matrix& piv_thres, bool scale, bool FixedQ, + double droptol, bool milu, bool udiag) { #ifdef HAVE_UMFPACK if (milu) @@ -251,46 +251,46 @@ double tmp = octave_sparse_params::get_key ("spumoni"); if (!xisnan (tmp)) - Control (UMFPACK_PRL) = tmp; + Control (UMFPACK_PRL) = tmp; if (piv_thres.nelem() == 2) - { - tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); - if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); - if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } + { + tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); + if (!xisnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); + if (!xisnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } else - { - tmp = octave_sparse_params::get_key ("piv_tol"); - if (!xisnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + { + tmp = octave_sparse_params::get_key ("piv_tol"); + if (!xisnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - tmp = octave_sparse_params::get_key ("sym_tol"); - if (!xisnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } + tmp = octave_sparse_params::get_key ("sym_tol"); + if (!xisnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } if (droptol >= 0.) - Control (UMFPACK_DROPTOL) = droptol; + Control (UMFPACK_DROPTOL) = droptol; // Set whether we are allowed to modify Q or not if (FixedQ) - Control (UMFPACK_FIXQ) = 1.0; + Control (UMFPACK_FIXQ) = 1.0; else - { - tmp = octave_sparse_params::get_key ("autoamd"); - if (!xisnan (tmp)) - Control (UMFPACK_FIXQ) = tmp; - } + { + tmp = octave_sparse_params::get_key ("autoamd"); + if (!xisnan (tmp)) + Control (UMFPACK_FIXQ) = tmp; + } if (scale) - Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; + Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; else - Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; + Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; UMFPACK_DNAME (report_control) (control); @@ -299,7 +299,7 @@ const double *Ax = a.data (); UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, - control); + control); void *Symbolic; Matrix Info (1, UMFPACK_INFO); @@ -308,148 +308,148 @@ // Null loop so that qinit is imediately deallocated when not needed do { - OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); - for (octave_idx_type i = 0; i < nc; i++) - qinit [i] = static_cast<octave_idx_type> (Qinit (i)); + for (octave_idx_type i = 0; i < nc; i++) + qinit [i] = static_cast<octave_idx_type> (Qinit (i)); - status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, - qinit, &Symbolic, control, info); + status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, + qinit, &Symbolic, control, info); } while (0); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU symbolic factorization failed"); + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU symbolic factorization failed"); - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); - UMFPACK_DNAME (free_symbolic) (&Symbolic) ; - } + UMFPACK_DNAME (free_symbolic) (&Symbolic) ; + } else - { - UMFPACK_DNAME (report_symbolic) (Symbolic, control); + { + UMFPACK_DNAME (report_symbolic) (Symbolic, control); - void *Numeric; - status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, - &Numeric, control, info) ; - UMFPACK_DNAME (free_symbolic) (&Symbolic) ; + void *Numeric; + status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, + &Numeric, control, info) ; + UMFPACK_DNAME (free_symbolic) (&Symbolic) ; - cond = Info (UMFPACK_RCOND); + cond = Info (UMFPACK_RCOND); - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU numeric factorization failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU numeric factorization failed"); - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); - UMFPACK_DNAME (free_numeric) (&Numeric); - } - else - { - UMFPACK_DNAME (report_numeric) (Numeric, control); + UMFPACK_DNAME (free_numeric) (&Numeric); + } + else + { + UMFPACK_DNAME (report_numeric) (Numeric, control); - octave_idx_type lnz, unz, ignore1, ignore2, ignore3; - status = UMFPACK_DNAME (get_lunz) (&lnz, &unz, &ignore1, &ignore2, - &ignore3, Numeric) ; - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU extracting LU factors failed"); + octave_idx_type lnz, unz, ignore1, ignore2, ignore3; + status = UMFPACK_DNAME (get_lunz) (&lnz, &unz, &ignore1, &ignore2, + &ignore3, Numeric) ; + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU extracting LU factors failed"); - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); - UMFPACK_DNAME (free_numeric) (&Numeric); - } - else - { - octave_idx_type n_inner = (nr < nc ? nr : nc); + UMFPACK_DNAME (free_numeric) (&Numeric); + } + else + { + octave_idx_type n_inner = (nr < nc ? nr : nc); - if (lnz < 1) - Lfact = SparseMatrix (n_inner, nr, - static_cast<octave_idx_type> (1)); - else - Lfact = SparseMatrix (n_inner, nr, lnz); + if (lnz < 1) + Lfact = SparseMatrix (n_inner, nr, + static_cast<octave_idx_type> (1)); + else + Lfact = SparseMatrix (n_inner, nr, lnz); - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - double *Ltx = Lfact.data (); + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + double *Ltx = Lfact.data (); - if (unz < 1) - Ufact = SparseMatrix (n_inner, nc, - static_cast<octave_idx_type> (1)); - else - Ufact = SparseMatrix (n_inner, nc, unz); + if (unz < 1) + Ufact = SparseMatrix (n_inner, nc, + static_cast<octave_idx_type> (1)); + else + Ufact = SparseMatrix (n_inner, nc, unz); - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - double *Ux = Ufact.data (); + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + double *Ux = Ufact.data (); - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); - P.resize (nr); - octave_idx_type *p = P.fortran_vec (); + P.resize (nr); + octave_idx_type *p = P.fortran_vec (); - Q.resize (nc); - octave_idx_type *q = Q.fortran_vec (); + Q.resize (nc); + octave_idx_type *q = Q.fortran_vec (); - octave_idx_type do_recip; - status = UMFPACK_DNAME (get_numeric) (Ltp, Ltj, - Ltx, Up, Uj, Ux, p, q, - 0, &do_recip, - Rx, Numeric) ; + octave_idx_type do_recip; + status = UMFPACK_DNAME (get_numeric) (Ltp, Ltj, + Ltx, Up, Uj, Ux, p, q, + 0, &do_recip, + Rx, Numeric) ; - UMFPACK_DNAME (free_numeric) (&Numeric) ; + UMFPACK_DNAME (free_numeric) (&Numeric) ; - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseLU::SparseLU extracting LU factors failed"); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseLU::SparseLU extracting LU factors failed"); - UMFPACK_DNAME (report_status) (control, status); - } - else - { - Lfact = Lfact.transpose (); + UMFPACK_DNAME (report_status) (control, status); + } + else + { + Lfact = Lfact.transpose (); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; - UMFPACK_DNAME (report_matrix) (nr, n_inner, - Lfact.cidx (), - Lfact.ridx (), - Lfact.data (), - 1, control); - UMFPACK_DNAME (report_matrix) (n_inner, nc, - Ufact.cidx (), - Ufact.ridx (), - Ufact.data (), - 1, control); - UMFPACK_DNAME (report_perm) (nr, p, control); - UMFPACK_DNAME (report_perm) (nc, q, control); - } + UMFPACK_DNAME (report_matrix) (nr, n_inner, + Lfact.cidx (), + Lfact.ridx (), + Lfact.data (), + 1, control); + UMFPACK_DNAME (report_matrix) (n_inner, nc, + Ufact.cidx (), + Ufact.ridx (), + Ufact.data (), + 1, control); + UMFPACK_DNAME (report_perm) (nr, p, control); + UMFPACK_DNAME (report_perm) (nc, q, control); + } - UMFPACK_DNAME (report_info) (control, info); - } - } - } + UMFPACK_DNAME (report_info) (control, info); + } + } + } if (udiag) - (*current_liboctave_error_handler) - ("Option udiag of incomplete LU not implemented"); + (*current_liboctave_error_handler) + ("Option udiag of incomplete LU not implemented"); } #else (*current_liboctave_error_handler) ("UMFPACK not installed");
--- a/liboctave/boolNDArray.cc +++ b/liboctave/boolNDArray.cc @@ -123,12 +123,12 @@ case 2: retval = boolMatrix (Array2<bool> (*this, dimensions(0), - dimensions(1))); + dimensions(1))); break; default: (*current_liboctave_error_handler) - ("invalid conversion of boolNDArray to boolMatrix"); + ("invalid conversion of boolNDArray to boolMatrix"); break; } @@ -137,15 +137,15 @@ void boolNDArray::increment_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions, - int start_dimension) + const dim_vector& dimensions, + int start_dimension) { ::increment_index (ra_idx, dimensions, start_dimension); } octave_idx_type boolNDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); }
--- a/liboctave/boolSparse.cc +++ b/liboctave/boolSparse.cc @@ -52,7 +52,7 @@ for (octave_idx_type i = 0; i < nc + 1; i++) if (cidx(i) != a.cidx(i)) - return false; + return false; for (octave_idx_type i = 0; i < nz; i++) if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) @@ -108,15 +108,15 @@ for (octave_idx_type i = 0; i < nc; i++) { for (octave_idx_type j = 0; j < nr; j++) - { - if (jj < cidx(i+1) && ridx(jj) == j) - jj++; - else - { - r.data(ii) = true; - r.ridx(ii++) = j; - } - } + { + if (jj < cidx(i+1) && ridx(jj) == j) + jj++; + else + { + r.data(ii) = true; + r.ridx(ii++) = j; + } + } r.cidx (i+1) = ii; } @@ -171,7 +171,7 @@ { octave_quit (); for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - os << a.ridx(i) + 1 << " " << j + 1 << " " << a.data(i) << "\n"; + os << a.ridx(i) + 1 << " " << j + 1 << " " << a.data(i) << "\n"; } return os;
--- a/liboctave/chMatrix.cc +++ b/liboctave/chMatrix.cc @@ -84,7 +84,7 @@ const std::string si = s(i); octave_idx_type nc = si.length (); for (octave_idx_type j = 0; j < nc; j++) - elem (i, j) = si[j]; + elem (i, j) = si[j]; } } @@ -111,13 +111,13 @@ octave_idx_type s_len = strlen (s); if (r < 0 || r >= rows () || c < 0 || c + s_len - 1 > cols ()) - { - (*current_liboctave_error_handler) ("range error for insert"); - return *this; - } + { + (*current_liboctave_error_handler) ("range error for insert"); + return *this; + } for (octave_idx_type i = 0; i < s_len; i++) - elem (r, c+i) = s[i]; + elem (r, c+i) = s[i]; } return *this; } @@ -154,20 +154,20 @@ if (! raw) { if (strip_ws) - { - while (--nc >= 0) - { - char c = retval[nc]; - if (c && c != ' ') - break; - } - } + { + while (--nc >= 0) + { + char c = retval[nc]; + if (c && c != ' ') + break; + } + } else - { - while (--nc >= 0) - if (retval[nc]) - break; - } + { + while (--nc >= 0) + if (retval[nc]) + break; + } retval.resize (nc+1); }
--- a/liboctave/chNDArray.cc +++ b/liboctave/chNDArray.cc @@ -70,22 +70,22 @@ double d = rb.elem (i); if (xisnan (d)) - { - (*current_liboctave_error_handler) - ("invalid conversion from NaN to character"); - return *this; - } + { + (*current_liboctave_error_handler) + ("invalid conversion from NaN to character"); + return *this; + } else - { - octave_idx_type ival = NINTbig (d); + { + octave_idx_type ival = NINTbig (d); - if (ival < 0 || ival > UCHAR_MAX) - // FIXME -- is there something - // better we could do? Should we warn the user? - ival = 0; + if (ival < 0 || ival > UCHAR_MAX) + // FIXME -- is there something + // better we could do? Should we warn the user? + ival = 0; - tmp.elem (i) = static_cast<char>(ival); - } + tmp.elem (i) = static_cast<char>(ival); + } } insert (tmp, ra_idx); @@ -121,12 +121,12 @@ case 2: retval = charMatrix (Array2<char> (*this, dimensions(0), - dimensions(1))); + dimensions(1))); break; default: (*current_liboctave_error_handler) - ("invalid conversion of charNDArray to charMatrix"); + ("invalid conversion of charNDArray to charMatrix"); break; } @@ -135,15 +135,15 @@ void charNDArray::increment_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions, - int start_dimension) + const dim_vector& dimensions, + int start_dimension) { ::increment_index (ra_idx, dimensions, start_dimension); } octave_idx_type charNDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); }
--- a/liboctave/cmd-edit.cc +++ b/liboctave/cmd-edit.cc @@ -217,18 +217,18 @@ // Bind operate-and-get-next. octave_rl_add_defun ("operate-and-get-next", - gnu_readline::operate_and_get_next, - octave_rl_ctrl ('O')); + gnu_readline::operate_and_get_next, + octave_rl_ctrl ('O')); // And the history search functions. octave_rl_add_defun ("history-search-backward", - gnu_readline::history_search_backward, - octave_rl_meta ('P')); + gnu_readline::history_search_backward, + octave_rl_meta ('P')); octave_rl_add_defun ("history-search-forward", - gnu_readline::history_search_forward, - octave_rl_meta ('N')); + gnu_readline::history_search_forward, + octave_rl_meta ('N')); } void @@ -429,10 +429,10 @@ if (f) octave_rl_add_defun ("accept-line", gnu_readline::command_accept_line, - ::octave_rl_ctrl ('M')); + ::octave_rl_ctrl ('M')); else octave_rl_add_defun ("accept-line", ::octave_rl_newline, - ::octave_rl_ctrl ('M')); + ::octave_rl_ctrl ('M')); } gnu_readline::completion_fcn @@ -480,23 +480,23 @@ fn = ::octave_rl_filename_completion_function (text.c_str (), count); if (fn) - { - if (count == n) - { - // Famous last words: Most large directories will not - // have more than a few hundred files, so we should not - // resize too many times even if the growth is linear... + { + if (count == n) + { + // Famous last words: Most large directories will not + // have more than a few hundred files, so we should not + // resize too many times even if the growth is linear... - n += 100; - retval.resize (n); - } + n += 100; + retval.resize (n); + } - retval[count++] = fn; + retval[count++] = fn; - free (fn); - } + free (fn); + } else - break; + break; } retval.resize (count); @@ -831,7 +831,7 @@ if (! instance) { current_liboctave_error_handler - ("unable to create command history object!"); + ("unable to create command history object!"); retval = false; } @@ -865,7 +865,7 @@ startup_hook_fcn f = *p; if (f) - f (); + f (); } return 0; @@ -886,7 +886,7 @@ event_hook_fcn f = *p; if (f) - f (); + f (); } return 0; @@ -1184,10 +1184,10 @@ startup_hook_set_iterator p = startup_hook_set.find (f); if (p != startup_hook_set.end ()) - startup_hook_set.erase (p); + startup_hook_set.erase (p); if (startup_hook_set.empty ()) - instance->restore_startup_hook (); + instance->restore_startup_hook (); } } @@ -1214,10 +1214,10 @@ event_hook_set_iterator p = event_hook_set.find (f); if (p != event_hook_set.end ()) - event_hook_set.erase (p); + event_hook_set.erase (p); if (event_hook_set.empty ()) - instance->restore_event_hook (); + instance->restore_event_hook (); } } @@ -1256,28 +1256,28 @@ // Return a string which will be printed as a prompt. The string may // contain special characters which are decoded as follows: // -// \a bell (ascii 07) -// \d the date -// \e escape (ascii 033) -// \h the hostname up to the first `.' -// \H the hostname -// \n CRLF -// \r CR -// \s the name of the shell (program) -// \t the time -// \T the time in 12-hour hh:mm:ss format -// \@ the time in 12-hour hh:mm am/pm format -// \A the time in 24-hour hh:mm format -// \u your username -// \w the current working directory -// \W the last element of PWD -// \! the history number of this command -// \# the command number of this command -// \$ a $ or a # if you are root -// \nnn character code nnn in octal -// \\ a backslash -// \[ begin a sequence of non-printing chars -// \] end a sequence of non-printing chars +// \a bell (ascii 07) +// \d the date +// \e escape (ascii 033) +// \h the hostname up to the first `.' +// \H the hostname +// \n CRLF +// \r CR +// \s the name of the shell (program) +// \t the time +// \T the time in 12-hour hh:mm:ss format +// \@ the time in 12-hour hh:mm am/pm format +// \A the time in 24-hour hh:mm format +// \u your username +// \w the current working directory +// \W the last element of PWD +// \! the history number of this command +// \# the command number of this command +// \$ a $ or a # if you are root +// \nnn character code nnn in octal +// \\ a backslash +// \[ begin a sequence of non-printing chars +// \] end a sequence of non-printing chars std::string command_editor::do_decode_prompt_string (const std::string& s) @@ -1295,218 +1295,218 @@ i++; if (c == '\\') - { - c = s[i]; + { + c = s[i]; - switch (c) - { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - // Maybe convert an octal number. - { - int n = read_octal (s.substr (i, 3)); + switch (c) + { + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + // Maybe convert an octal number. + { + int n = read_octal (s.substr (i, 3)); - temp = "\\"; + temp = "\\"; - if (n != -1) - { - i += 3; - temp[0] = n; - } + if (n != -1) + { + i += 3; + temp[0] = n; + } - c = 0; - goto add_string; - } + c = 0; + goto add_string; + } - case 'a': - { - temp = '\a'; + case 'a': + { + temp = '\a'; - goto add_string; - } + goto add_string; + } - case 'e': - { - temp = '\033'; + case 'e': + { + temp = '\033'; - goto add_string; - } + goto add_string; + } - case 'r': - { - temp = '\r'; + case 'r': + { + temp = '\r'; - goto add_string; - } + goto add_string; + } - case 'd': - case 't': - case 'T': - case '@': - case 'A': - // Make the current time/date into a string. - { - octave_localtime now; + case 'd': + case 't': + case 'T': + case '@': + case 'A': + // Make the current time/date into a string. + { + octave_localtime now; - if (c == 'd') - temp = now.strftime ("%a %b %d"); - else if (c == 't') - temp = now.strftime ("%H:%M:%S"); - else if (c == 'T') - temp = now.strftime ("%I:%M:%S"); - else if (c == '@') - temp = now.strftime ("%I:%M %p"); - else if (c == 'A') - temp = now.strftime ("%H:%M"); + if (c == 'd') + temp = now.strftime ("%a %b %d"); + else if (c == 't') + temp = now.strftime ("%H:%M:%S"); + else if (c == 'T') + temp = now.strftime ("%I:%M:%S"); + else if (c == '@') + temp = now.strftime ("%I:%M %p"); + else if (c == 'A') + temp = now.strftime ("%H:%M"); - goto add_string; - } + goto add_string; + } - case 'n': - { - temp = newline_chars (); + case 'n': + { + temp = newline_chars (); - goto add_string; - } + goto add_string; + } - case 's': - { - temp = octave_env::get_program_name (); - temp = octave_env::base_pathname (temp); + case 's': + { + temp = octave_env::get_program_name (); + temp = octave_env::base_pathname (temp); - goto add_string; - } + goto add_string; + } - case 'w': - case 'W': - { - temp = octave_env::get_current_directory (); + case 'w': + case 'W': + { + temp = octave_env::get_current_directory (); - std::string home_dir = octave_env::get_home_directory (); + std::string home_dir = octave_env::get_home_directory (); - if (c == 'W' && (home_dir.empty () || temp != home_dir)) - { - if (temp != "/" && temp != "//") - { - size_t pos = temp.rfind ('/'); + if (c == 'W' && (home_dir.empty () || temp != home_dir)) + { + if (temp != "/" && temp != "//") + { + size_t pos = temp.rfind ('/'); - if (pos != std::string::npos && pos != 0) - temp = temp.substr (pos + 1); - } - } - else - temp = octave_env::polite_directory_format (temp); + if (pos != std::string::npos && pos != 0) + temp = temp.substr (pos + 1); + } + } + else + temp = octave_env::polite_directory_format (temp); - goto add_string; - } + goto add_string; + } - case 'u': - { - temp = octave_env::get_user_name (); + case 'u': + { + temp = octave_env::get_user_name (); - goto add_string; - } + goto add_string; + } - case 'H': - { - temp = octave_env::get_host_name (); + case 'H': + { + temp = octave_env::get_host_name (); - goto add_string; - } + goto add_string; + } - case 'h': - { - temp = octave_env::get_host_name (); + case 'h': + { + temp = octave_env::get_host_name (); - size_t pos = temp.find ('.'); + size_t pos = temp.find ('.'); - if (pos != std::string::npos) - temp.resize (pos); - - goto add_string; - } + if (pos != std::string::npos) + temp.resize (pos); + + goto add_string; + } - case '#': - { - char number_buffer[128]; - sprintf (number_buffer, "%d", command_number); - temp = number_buffer; + case '#': + { + char number_buffer[128]; + sprintf (number_buffer, "%d", command_number); + temp = number_buffer; - goto add_string; - } + goto add_string; + } - case '!': - { - char number_buffer[128]; - int num = command_history::current_number (); - if (num > 0) + case '!': + { + char number_buffer[128]; + int num = command_history::current_number (); + if (num > 0) sprintf (number_buffer, "%d", num); - else - strcpy (number_buffer, "!"); - temp = number_buffer; + else + strcpy (number_buffer, "!"); + temp = number_buffer; - goto add_string; - } + goto add_string; + } - case '$': - { + case '$': + { #if defined (HAVE_GETEUID) - temp = (::geteuid () == 0 ? "#" : "$"); + temp = (::geteuid () == 0 ? "#" : "$"); #else - temp = "$"; + temp = "$"; #endif - goto add_string; - } + goto add_string; + } #if defined (USE_READLINE) - case '[': - case ']': - { - temp.resize (1); + case '[': + case ']': + { + temp.resize (1); - temp[0] = ((c == '[') - ? ::octave_rl_prompt_start_ignore () - : ::octave_rl_prompt_end_ignore ()); + temp[0] = ((c == '[') + ? ::octave_rl_prompt_start_ignore () + : ::octave_rl_prompt_end_ignore ()); - goto add_string; - } + goto add_string; + } #endif - case '\\': - { - temp = "\\"; + case '\\': + { + temp = "\\"; - goto add_string; - } + goto add_string; + } - default: - { - temp = "\\ "; - temp[1] = c; + default: + { + temp = "\\ "; + temp[1] = c; - goto add_string; - } + goto add_string; + } - add_string: - { - if (c) - i++; + add_string: + { + if (c) + i++; - result.append (temp); + result.append (temp); - break; - } - } - } + break; + } + } + } else - result += c; + result += c; } return result;
--- a/liboctave/cmd-hist.cc +++ b/liboctave/cmd-hist.cc @@ -114,8 +114,8 @@ if (! do_ignoring_entries ()) { if (s.empty () - || (s.length () == 1 && (s[0] == '\r' || s[0] == '\n'))) - return; + || (s.length () == 1 && (s[0] == '\r' || s[0] == '\n'))) + return; ::octave_add_history (s.c_str ()); @@ -191,11 +191,11 @@ char *line = ::octave_history_goto_mark (mark); if (line) - { - command_editor::insert_text (line); + { + command_editor::insert_text (line); - command_editor::clear_undo_list (); - } + command_editor::clear_undo_list (); + } } mark = 0; @@ -214,13 +214,13 @@ int status = ::octave_read_history (f.c_str ()); if (status != 0 && must_exist) - error (status); + error (status); else - { - lines_in_file = do_where (); + { + lines_in_file = do_where (); - ::octave_using_history (); - } + ::octave_using_history (); + } } else error ("gnu_history::read: missing file name"); @@ -228,7 +228,7 @@ void gnu_history::do_read_range (const std::string& f, int from, int to, - bool must_exist) + bool must_exist) { if (from < 0) from = lines_in_file; @@ -238,13 +238,13 @@ int status = ::octave_read_history_range (f.c_str (), from, to); if (status != 0 && must_exist) - error (status); + error (status); else - { - lines_in_file = do_where (); + { + lines_in_file = do_where (); - ::octave_using_history (); - } + ::octave_using_history (); + } } else error ("gnu_history::read_range: missing file name"); @@ -263,7 +263,7 @@ int status = ::octave_write_history (f.c_str ()); if (status != 0) - error (status); + error (status); } else error ("gnu_history::write: missing file name"); @@ -275,39 +275,39 @@ if (lines_this_session) { if (lines_this_session < do_where ()) - { - // Create file if it doesn't already exist. + { + // Create file if it doesn't already exist. - std::string f = f_arg; + std::string f = f_arg; - if (f.empty ()) - f = xfile; + if (f.empty ()) + f = xfile; - if (! f.empty ()) - { - file_stat fs (f); + if (! f.empty ()) + { + file_stat fs (f); - if (! fs) - { - int tem; + if (! fs) + { + int tem; - tem = open (f.c_str (), O_CREAT, 0666); - close (tem); - } + tem = open (f.c_str (), O_CREAT, 0666); + close (tem); + } - int status - = ::octave_append_history (lines_this_session, f.c_str ()); + int status + = ::octave_append_history (lines_this_session, f.c_str ()); - if (status != 0) - error (status); - else - lines_in_file += lines_this_session; + if (status != 0) + error (status); + else + lines_in_file += lines_this_session; - lines_this_session = 0; - } - else - error ("gnu_history::append: missing file name"); - } + lines_this_session = 0; + } + else + error ("gnu_history::append: missing file name"); + } } } @@ -366,7 +366,7 @@ if (! f.empty ())