Mercurial > octave-nkf
changeset 10314:07ebe522dac2
untabify liboctave C++ sources
line wrap: on
line diff
--- a/liboctave/Array-C.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Array-C.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Array-fC.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Array-util.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Array.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CColVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CDiagMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CRowVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CSparse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/ChangeLog Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxAEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxGEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxHESS.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxQRP.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxSCHUR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CmplxSVD.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/CollocWt.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/DASPK.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/DASRT.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/DASSL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/EIG.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/LSODE.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/MSparse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/MatrixType.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/ODES.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Quad.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Range.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Sparse-C.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/Sparse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparseCmplxCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparseCmplxLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparseCmplxQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparseQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparsedbleCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/SparsedbleLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/boolNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/boolSparse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/chMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/chNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/cmd-edit.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/cmd-hist.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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 ()) { if (n < 0) - n = xsize; + n = xsize; stifle (n); @@ -389,7 +389,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create command history object!"); + ("unable to create command history object!"); retval = false; } @@ -558,7 +558,7 @@ void command_history::read_range (const std::string& f, int from, int to, - bool must_exist) + bool must_exist) { if (instance_ok ()) instance->do_read_range (f, from, to, must_exist); @@ -749,17 +749,17 @@ 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 ()) - error ("command_history::append: missing file name"); - } + if (f.empty ()) + error ("command_history::append: missing file name"); + } } }
--- a/liboctave/dColVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dColVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,11 +42,11 @@ { F77_RET_T F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const double&, - const double*, const octave_idx_type&, const double*, - const octave_idx_type&, const double&, double*, - const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const double&, + const double*, const octave_idx_type&, const double*, + const octave_idx_type&, const double&, double*, + const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); } // Column Vector class. @@ -82,7 +82,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; @@ -98,7 +98,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -122,7 +122,7 @@ make_unique (); for (octave_idx_type i = r1; i <= r2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -242,17 +242,17 @@ else { if (nr == 0 || nc == 0) - retval.resize (nr, 0.0); + retval.resize (nr, 0.0); else - { - retval.resize (nr); + { + retval.resize (nr); - for (octave_idx_type i = 0; i < a_len; i++) - retval.elem (i) = a.elem (i) * m.elem (i, i); + for (octave_idx_type i = 0; i < a_len; i++) + retval.elem (i) = a.elem (i) * m.elem (i, i); - for (octave_idx_type i = a_len; i < nr; i++) - retval.elem (i) = 0.0; - } + for (octave_idx_type i = a_len; i < nr; i++) + retval.elem (i) = 0.0; + } } return retval;
--- a/liboctave/dDiagMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dDiagMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -155,7 +155,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = DiagMatrix (mx_inline_real_dup (a.data (), a_len), a.rows (), - a.cols ()); + a.cols ()); return retval; } @@ -166,7 +166,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = DiagMatrix (mx_inline_imag_dup (a.data (), a_len), a.rows (), - a.cols ()); + a.cols ()); return retval; } @@ -293,12 +293,12 @@ for (octave_idx_type i = 0; i < len; 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; @@ -389,12 +389,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) */ << 0.0; - } + { + if (i == j) + os << " " /* setw (field_width) */ << a.elem (i, i); + else + os << " " /* setw (field_width) */ << 0.0; + } os << "\n"; } return os;
--- a/liboctave/dMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -64,151 +64,151 @@ { 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 (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, double*, 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 (dgemm, DGEMM) (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 double*, const octave_idx_type&, - const double*, const octave_idx_type&, const double&, - double*, 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 double&, const double*, const octave_idx_type&, + const double*, const octave_idx_type&, const double&, + double*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const double&, - const double*, const octave_idx_type&, const double*, - const octave_idx_type&, const double&, double*, - const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const double&, + const double*, const octave_idx_type&, const double*, + const octave_idx_type&, const double&, double*, + const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xddot, XDDOT) (const octave_idx_type&, const double*, const octave_idx_type&, - const double*, const octave_idx_type&, double&); + const double*, const octave_idx_type&, double&); F77_RET_T F77_FUNC (dsyrk, DSYRK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const double&, const double*, const octave_idx_type&, - const double&, double*, 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 double*, const octave_idx_type&, + const double&, double*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgetrf, DGETRF) (const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, - octave_idx_type*, octave_idx_type&); + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (dgetrs, DGETRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, const octave_idx_type&, - const double*, const octave_idx_type&, - const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const double*, const octave_idx_type&, + const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgetri, DGETRI) (const octave_idx_type&, double*, const octave_idx_type&, const octave_idx_type*, - double*, const octave_idx_type&, octave_idx_type&); + double*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dgecon, DGECON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, double*, - const octave_idx_type&, const double&, double&, - double*, octave_idx_type*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const double&, double&, + double*, octave_idx_type*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgelsy, DGELSY) (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*, double&, octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type&); + double*, const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dgelsd, DGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - double*, const octave_idx_type&, double*, - const octave_idx_type&, double*, double&, octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type*, - octave_idx_type&); + double*, const octave_idx_type&, double*, + const octave_idx_type&, double*, double&, octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type*, + octave_idx_type&); 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); + double *, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpocon, DPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - double*, const octave_idx_type&, const double&, - double&, double*, octave_idx_type*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + double*, const octave_idx_type&, const double&, + double&, double*, octave_idx_type*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpotrs, DPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const double*, - const octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const double*, + const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dtrtri, DTRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const double*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dtrcon, DTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const double*, const octave_idx_type&, double&, - 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, const octave_idx_type&, + const double*, const octave_idx_type&, double&, + double*, 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 (dtrtrs, DTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const double*, - const octave_idx_type&, double*, - 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 double*, + const octave_idx_type&, double*, + 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 (dlartg, DLARTG) (const double&, const double&, double&, - double&, double&); + double&, double&); F77_RET_T F77_FUNC (dtrsyl, DTRSYL) (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&, const double*, - const octave_idx_type&, const double*, 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 double*, const octave_idx_type&, const double*, + const octave_idx_type&, const double*, const octave_idx_type&, + double&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xdlange, XDLANGE) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const double*, - const octave_idx_type&, double*, double& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const double*, + const octave_idx_type&, double*, double& + F77_CHAR_ARG_LEN_DECL); } // Matrix class. @@ -283,9 +283,9 @@ if (is_square () && rows () > 0) { for (octave_idx_type i = 0; i < rows (); i++) - for (octave_idx_type j = i+1; j < cols (); j++) - if (elem (i, j) != elem (j, i)) - return false; + for (octave_idx_type j = i+1; j < cols (); j++) + if (elem (i, j) != elem (j, i)) + return false; return true; } @@ -316,7 +316,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; @@ -338,7 +338,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; @@ -365,7 +365,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; @@ -382,8 +382,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; @@ -410,8 +410,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; @@ -497,7 +497,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return Matrix (); } @@ -516,7 +516,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return Matrix (); } @@ -535,7 +535,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return Matrix (); } @@ -554,7 +554,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return Matrix (); } @@ -642,7 +642,7 @@ Matrix Matrix::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); @@ -665,7 +665,7 @@ Matrix Matrix::tinverse (MatrixType &mattype, octave_idx_type& info, double& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { Matrix retval; @@ -683,38 +683,38 @@ double *tmp_data = retval.fortran_vec (); F77_XFCN (dtrtri, DTRTRI, (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 dtrcon_info = 0; - char job = '1'; - - OCTAVE_LOCAL_BUFFER (double, work, 3 * nr); - OCTAVE_LOCAL_BUFFER (octave_idx_type, iwork, nr); - - F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&udiag, 1), - nr, tmp_data, nr, rcon, - work, iwork, dtrcon_info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (dtrcon_info != 0) - info = -1; - } + { + octave_idx_type dtrcon_info = 0; + char job = '1'; + + OCTAVE_LOCAL_BUFFER (double, work, 3 * nr); + OCTAVE_LOCAL_BUFFER (octave_idx_type, iwork, nr); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&udiag, 1), + nr, tmp_data, nr, rcon, + work, iwork, dtrcon_info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (dtrcon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore matrix contents. + retval = *this; // Restore matrix contents. } return retval; @@ -723,7 +723,7 @@ Matrix Matrix::finverse (MatrixType &mattype, octave_idx_type& info, double& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { Matrix retval; @@ -745,7 +745,7 @@ // Query the optimum work array size. F77_XFCN (dgetri, DGETRI, (nc, tmp_data, nr, pipvt, - z.fortran_vec (), lwork, info)); + z.fortran_vec (), lwork, info)); lwork = static_cast<octave_idx_type> (z(0)); lwork = (lwork < 2 *nc ? 2*nc : lwork); @@ -757,46 +757,46 @@ // Calculate the norm of the matrix, for later use. double anorm = 0; 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 (dgetrf, DGETRF, (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) - { - octave_idx_type dgecon_info = 0; - - // Now calculate the condition number for non-singular matrix. - char job = '1'; - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, dgecon_info - F77_CHAR_ARG_LEN (1))); - - if (dgecon_info != 0) - info = -1; - } + { + octave_idx_type dgecon_info = 0; + + // Now calculate the condition number for non-singular matrix. + char job = '1'; + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, dgecon_info + F77_CHAR_ARG_LEN (1))); + + if (dgecon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore matrix contents. + retval = *this; // Restore matrix contents. else - { - octave_idx_type dgetri_info = 0; - - F77_XFCN (dgetri, DGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, dgetri_info)); - - if (dgetri_info != 0) - info = -1; - } + { + octave_idx_type dgetri_info = 0; + + F77_XFCN (dgetri, DGETRI, (nc, tmp_data, nr, pipvt, + pz, lwork, dgetri_info)); + + if (dgetri_info != 0) + info = -1; + } if (info != 0) - mattype.mark_as_rectangular(); + mattype.mark_as_rectangular(); } return retval; @@ -804,7 +804,7 @@ Matrix Matrix::inverse (MatrixType &mattype, octave_idx_type& info, double& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { int typ = mattype.type (false); Matrix ret; @@ -817,25 +817,25 @@ else { if (mattype.is_hermitian ()) - { - CHOL 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 (); - } + { + CHOL 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 = Matrix (rows (), columns (), octave_Inf); + ret = Matrix (rows (), columns (), octave_Inf); } return ret; @@ -859,9 +859,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) @@ -1123,12 +1123,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; @@ -1192,12 +1192,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; @@ -1384,143 +1384,143 @@ 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 double *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } + { + const double *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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_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 double *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } + { + const double *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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; - Matrix atmp = *this; - double *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 (dpotrf, DPOTRF, (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<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, piz, 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<double> z (4 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dgetrf, DGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (info != 0) - { - rcon = 0.0; - mattype.mark_as_rectangular (); - } - else - { - char job = '1'; - F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } - } - } + { + double anorm = -1.0; + Matrix atmp = *this; + double *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 (dpotrf, DPOTRF, (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<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, piz, 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<double> z (4 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgetrf, DGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (info != 0) + { + rcon = 0.0; + mattype.mark_as_rectangular (); + } + else + { + char job = '1'; + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0.0; + } + } + } else - rcon = 0.0; + rcon = 0.0; } return rcon; @@ -1528,8 +1528,8 @@ Matrix Matrix::utsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, - double& rcon, solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + double& rcon, solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { Matrix retval; @@ -1546,81 +1546,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 double *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, 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; - double *result = retval.fortran_vec (); - - char uplo = 'U'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (dtrtrs, DTRTRS, (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 double *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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; + double *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (dtrtrs, DTRTRS, (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; @@ -1628,8 +1628,8 @@ Matrix Matrix::ltsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, - double& rcon, solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + double& rcon, solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { Matrix retval; @@ -1646,81 +1646,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 double *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, 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; - double *result = retval.fortran_vec (); - - char uplo = 'L'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (dtrtrs, DTRTRS, (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 double *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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; + double *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (dtrtrs, DTRTRS, (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; @@ -1728,8 +1728,8 @@ Matrix Matrix::fsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, - double& rcon, solve_singularity_handler sing_handler, - bool calc_cond) const + double& rcon, solve_singularity_handler sing_handler, + bool calc_cond) const { Matrix retval; @@ -1749,160 +1749,160 @@ double anorm = -1.; if (typ == MatrixType::Hermitian) - { - info = 0; - char job = 'L'; - Matrix atmp = *this; - double *tmp_data = atmp.fortran_vec (); - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (dpotrf, DPOTRF, (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<double> z (3 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, piz, 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; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (dpotrs, DPOTRS, (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'; + Matrix atmp = *this; + double *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (dpotrf, DPOTRF, (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<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, piz, 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; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (dpotrs, DPOTRS, (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 (); - - Matrix atmp = *this; - double *tmp_data = atmp.fortran_vec (); - if(anorm < 0.) - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - Array<double> z (4 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dgetrf, DGETRF, (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 (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, 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; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - char job = 'N'; - F77_XFCN (dgetrs, DGETRS, (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 (); + + Matrix atmp = *this; + double *tmp_data = atmp.fortran_vec (); + if(anorm < 0.) + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + Array<double> z (4 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgetrf, DGETRF, (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 (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, 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; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (dgetrs, DGETRS, (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 (); + } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1925,15 +1925,15 @@ Matrix Matrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (typ, b, info, rcon, 0); } Matrix Matrix::solve (MatrixType &mattype, 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 { Matrix retval; int typ = mattype.type (); @@ -1984,7 +1984,7 @@ ComplexMatrix Matrix::solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (typ, b, info, rcon, 0); } @@ -2018,8 +2018,8 @@ ComplexMatrix Matrix::solve (MatrixType &typ, const ComplexMatrix& 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 { Matrix tmp = stack_complex_matrix (b); tmp = solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt); @@ -2035,7 +2035,7 @@ ColumnVector Matrix::solve (MatrixType &typ, const ColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcon; return solve (typ, b, info, rcon); @@ -2043,14 +2043,14 @@ ColumnVector Matrix::solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, - double& rcon) const + double& rcon) const { return solve (typ, b, info, rcon, 0); } ColumnVector Matrix::solve (MatrixType &typ, 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 { Matrix tmp (b); return solve (typ, tmp, info, rcon, sing_handler, transt).column(static_cast<octave_idx_type> (0)); @@ -2065,7 +2065,7 @@ ComplexColumnVector Matrix::solve (MatrixType &typ, const ComplexColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { ComplexMatrix tmp (*this); return tmp.solve (typ, b, info); @@ -2073,7 +2073,7 @@ ComplexColumnVector Matrix::solve (MatrixType &typ, const ComplexColumnVector& b, - octave_idx_type& info, double& rcon) const + octave_idx_type& info, double& rcon) const { ComplexMatrix tmp (*this); return tmp.solve (typ, b, info, rcon); @@ -2081,8 +2081,8 @@ ComplexColumnVector Matrix::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 (*this); return tmp.solve(typ, b, info, rcon, sing_handler, transt); @@ -2111,7 +2111,7 @@ Matrix Matrix::solve (const Matrix& 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, true, transt); @@ -2140,7 +2140,7 @@ ComplexMatrix Matrix::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 { ComplexMatrix tmp (*this); return tmp.solve (b, info, rcon, sing_handler, transt); @@ -2168,7 +2168,7 @@ ColumnVector Matrix::solve (const ColumnVector& 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, transt); @@ -2197,7 +2197,7 @@ ComplexColumnVector Matrix::solve (const ComplexColumnVector& 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 (*this); return tmp.solve (b, info, rcon, sing_handler, transt); @@ -2222,7 +2222,7 @@ Matrix Matrix::lssolve (const Matrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (b, info, rank, rcon); @@ -2230,7 +2230,7 @@ Matrix Matrix::lssolve (const Matrix& b, octave_idx_type& info, - octave_idx_type& rank, double &rcon) const + octave_idx_type& rank, double &rcon) const { Matrix retval; @@ -2250,15 +2250,15 @@ octave_idx_type maxmn = m > n ? m : n; rcon = -1.0; if (m != n) - { - retval = Matrix (maxmn, nrhs, 0.0); - - 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 = Matrix (maxmn, nrhs, 0.0); + + 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; Matrix atmp = *this; double *tmp_data = atmp.fortran_vec (); @@ -2274,17 +2274,17 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("DGELSD", 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 ("DGELSD", 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 iwork because DGELSD in older versions // of LAPACK does not return it on a query call. @@ -2297,70 +2297,70 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; 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 (dgelsd, DGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, 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 DGELSD to operate // efficiently. if (n >= mnthr) - { - const octave_idx_type wlalsd - = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs + (smlsiz+1)*(smlsiz+1); - - 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; - - if (wlalsd > addend) - addend = wlalsd; - - const octave_idx_type lworkaround = 4*m + m*m + addend; - - if (work(0) < lworkaround) - work(0) = lworkaround; - } + { + const octave_idx_type wlalsd + = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs + (smlsiz+1)*(smlsiz+1); + + 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; + + if (wlalsd > addend) + addend = wlalsd; + + const octave_idx_type lworkaround = 4*m + m*m + addend; + + if (work(0) < lworkaround) + work(0) = lworkaround; + } else if (m >= n) - { - octave_idx_type lworkaround - = 12*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs + (smlsiz+1)*(smlsiz+1); - - if (work(0) < lworkaround) - work(0) = lworkaround; - } + { + octave_idx_type lworkaround + = 12*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs + (smlsiz+1)*(smlsiz+1); + + if (work(0) < lworkaround) + work(0) = lworkaround; + } lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (dgelsd, DGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + piwork, info)); if (rank < minmn) - (*current_liboctave_warning_handler) - ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); + (*current_liboctave_warning_handler) + ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); 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); } @@ -2389,7 +2389,7 @@ ComplexMatrix Matrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { ComplexMatrix tmp (*this); double rcon; @@ -2398,7 +2398,7 @@ ComplexMatrix Matrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank, double& rcon) const + octave_idx_type& rank, double& rcon) const { ComplexMatrix tmp (*this); return tmp.lssolve (b, info, rank, rcon); @@ -2423,7 +2423,7 @@ ColumnVector Matrix::lssolve (const ColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { double rcon; return lssolve (b, info, rank, rcon); @@ -2431,7 +2431,7 @@ ColumnVector Matrix::lssolve (const ColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, double &rcon) const + octave_idx_type& rank, double &rcon) const { ColumnVector retval; @@ -2452,14 +2452,14 @@ rcon = -1.0; if (m != n) - { - retval = ColumnVector (maxmn, 0.0); - - for (octave_idx_type i = 0; i < m; i++) - retval.elem (i) = b.elem (i); - } + { + retval = ColumnVector (maxmn, 0.0); + + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i) = b.elem (i); + } else - retval = b; + retval = b; Matrix atmp = *this; double *tmp_data = atmp.fortran_vec (); @@ -2475,10 +2475,10 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("DGELSD", 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 iwork because DGELSD in older versions // of LAPACK does not return it on a query call. @@ -2491,36 +2491,36 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; 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 (dgelsd, DGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, piwork, info)); lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (dgelsd, DGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + piwork, info)); if (rank < minmn) - { - if (rank < minmn) - (*current_liboctave_warning_handler) - ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); - if (s.elem (0) == 0.0) - rcon = 0.0; - else - rcon = s.elem (minmn - 1) / s.elem (0); - } + { + if (rank < minmn) + (*current_liboctave_warning_handler) + ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); + if (s.elem (0) == 0.0) + rcon = 0.0; + else + rcon = s.elem (minmn - 1) / s.elem (0); + } retval.resize (n, nrhs); } @@ -2549,7 +2549,7 @@ ComplexColumnVector Matrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { ComplexMatrix tmp (*this); double rcon; @@ -2558,7 +2558,7 @@ ComplexColumnVector Matrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, double &rcon) const + octave_idx_type& rank, double &rcon) const { ComplexMatrix tmp (*this); return tmp.lssolve (b, info, rank, rcon); @@ -2629,13 +2629,13 @@ retval = Matrix (len, a_len); double *c = retval.fortran_vec (); - + F77_XFCN (dgemm, DGEMM, (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; @@ -2651,14 +2651,14 @@ if (neg_zero) { for (octave_idx_type i = 0; i < nel; i++) - if (lo_ieee_signbit (elem (i))) - return true; + if (lo_ieee_signbit (elem (i))) + return true; } else { for (octave_idx_type i = 0; i < nel; i++) - if (elem (i) < 0) - return true; + if (elem (i) < 0) + return true; } return false; @@ -2673,7 +2673,7 @@ { double val = elem (i); if (xisnan (val)) - return true; + return true; } return false; @@ -2688,7 +2688,7 @@ { double val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -2703,7 +2703,7 @@ { double val = elem (i); if (val != 0 && val != 1) - return true; + return true; } return false; @@ -2718,9 +2718,9 @@ { double val = elem (i); if (xisnan (val) || D_NINT (val) == val) - continue; + continue; else - return false; + return false; } return true; @@ -2747,13 +2747,13 @@ double val = elem (i); if (val > max_val) - max_val = val; + max_val = val; if (val < min_val) - min_val = val; + min_val = val; if (D_NINT (val) != val) - return false; + return false; } return true; @@ -2769,8 +2769,8 @@ double val = elem (i); if (! (xisnan (val) || xisinf (val)) - && fabs (val) > FLT_MAX) - return true; + && fabs (val) > FLT_MAX) + return true; } return false; @@ -2856,33 +2856,33 @@ for (octave_idx_type i = 0; i < nr; i++) { - octave_idx_type idx_j; - - double tmp_min = octave_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_min = elem (i, idx_j); - - if (! xisnan (tmp_min)) - break; - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - double tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp < tmp_min) - { - idx_j = j; - tmp_min = tmp; - } - } - - result.elem (i) = tmp_min; - idx_arg.elem (i) = xisnan (tmp_min) ? 0 : idx_j; + octave_idx_type idx_j; + + double tmp_min = octave_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_min = elem (i, idx_j); + + if (! xisnan (tmp_min)) + break; + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + double tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp < tmp_min) + { + idx_j = j; + tmp_min = tmp; + } + } + + result.elem (i) = tmp_min; + idx_arg.elem (i) = xisnan (tmp_min) ? 0 : idx_j; } } @@ -2911,33 +2911,33 @@ for (octave_idx_type i = 0; i < nr; i++) { - octave_idx_type idx_j; - - double tmp_max = octave_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_max = elem (i, idx_j); - - if (! xisnan (tmp_max)) - break; - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - double tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp > tmp_max) - { - idx_j = j; - tmp_max = tmp; - } - } - - result.elem (i) = tmp_max; - idx_arg.elem (i) = xisnan (tmp_max) ? 0 : idx_j; + octave_idx_type idx_j; + + double tmp_max = octave_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_max = elem (i, idx_j); + + if (! xisnan (tmp_max)) + break; + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + double tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp > tmp_max) + { + idx_j = j; + tmp_max = tmp; + } + } + + result.elem (i) = tmp_max; + idx_arg.elem (i) = xisnan (tmp_max) ? 0 : idx_j; } } @@ -2966,33 +2966,33 @@ for (octave_idx_type j = 0; j < nc; j++) { - octave_idx_type idx_i; - - double tmp_min = octave_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_min = elem (idx_i, j); - - if (! xisnan (tmp_min)) - break; - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - double tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp < tmp_min) - { - idx_i = i; - tmp_min = tmp; - } - } - - result.elem (j) = tmp_min; - idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_i; + octave_idx_type idx_i; + + double tmp_min = octave_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_min = elem (idx_i, j); + + if (! xisnan (tmp_min)) + break; + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + double tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp < tmp_min) + { + idx_i = i; + tmp_min = tmp; + } + } + + result.elem (j) = tmp_min; + idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_i; } } @@ -3021,33 +3021,33 @@ for (octave_idx_type j = 0; j < nc; j++) { - octave_idx_type idx_i; - - double tmp_max = octave_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_max = elem (idx_i, j); - - if (! xisnan (tmp_max)) - break; - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - double tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp > tmp_max) - { - idx_i = i; - tmp_max = tmp; - } - } - - result.elem (j) = tmp_max; - idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_i; + octave_idx_type idx_i; + + double tmp_max = octave_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_max = elem (idx_i, j); + + if (! xisnan (tmp_max)) + break; + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + double tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp > tmp_max) + { + idx_i = i; + tmp_max = tmp; + } + } + + result.elem (j) = tmp_max; + idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_i; } } @@ -3060,10 +3060,10 @@ for (octave_idx_type i = 0; i < a.rows (); i++) { for (octave_idx_type j = 0; j < a.cols (); j++) - { - os << " "; - octave_write_double (os, a.elem (i, j)); - } + { + os << " "; + octave_write_double (os, a.elem (i, j)); + } os << "\n"; } return os; @@ -3079,14 +3079,14 @@ { double tmp; for (octave_idx_type i = 0; i < nr; i++) - for (octave_idx_type j = 0; j < nc; j++) - { - tmp = octave_read_value<double> (is); - if (is) - a.elem (i, j) = tmp; - else - goto done; - } + for (octave_idx_type j = 0; j < nc; j++) + { + tmp = octave_read_value<double> (is); + if (is) + a.elem (i, j) = tmp; + else + goto done; + } } done: @@ -3148,11 +3148,11 @@ double *px = cx.fortran_vec (); F77_XFCN (dtrsyl, DTRSYL, (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? @@ -3210,13 +3210,13 @@ else { if (a_nr == 0 || a_nc == 0 || b_nc == 0) - retval = Matrix (a_nr, b_nc, 0.0); + retval = Matrix (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 = Matrix (a_nr, b_nc); - double *c = retval.fortran_vec (); + double *c = retval.fortran_vec (); const char *ctra = get_blas_trans_arg (tra); F77_XFCN (dsyrk, DSYRK, (F77_CONST_CHAR_ARG2 ("U", 1), @@ -3231,25 +3231,25 @@ } else - { - octave_idx_type lda = a.rows (), tda = a.cols (); - octave_idx_type ldb = b.rows (), tdb = b.cols (); - - retval = Matrix (a_nr, b_nc); - double *c = retval.fortran_vec (); - - if (b_nc == 1) - { - if (a_nr == 1) - F77_FUNC (xddot, XDDOT) (a_nc, a.data (), 1, b.data (), 1, *c); - else - { + { + octave_idx_type lda = a.rows (), tda = a.cols (); + octave_idx_type ldb = b.rows (), tdb = b.cols (); + + retval = Matrix (a_nr, b_nc); + double *c = retval.fortran_vec (); + + if (b_nc == 1) + { + if (a_nr == 1) + F77_FUNC (xddot, XDDOT) (a_nc, a.data (), 1, b.data (), 1, *c); + else + { const char *ctra = get_blas_trans_arg (tra); - F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), - lda, tda, 1.0, a.data (), lda, - b.data (), 1, 0.0, c, 1 - F77_CHAR_ARG_LEN (1))); - } + F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), + lda, tda, 1.0, a.data (), lda, + b.data (), 1, 0.0, c, 1 + F77_CHAR_ARG_LEN (1))); + } } else if (a_nr == 1) { @@ -3259,18 +3259,18 @@ a.data (), 1, 0.0, c, 1 F77_CHAR_ARG_LEN (1))); } - else - { + else + { const char *ctra = get_blas_trans_arg (tra); const char *ctrb = get_blas_trans_arg (trb); - F77_XFCN (dgemm, DGEMM, (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 (dgemm, DGEMM, (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; @@ -3302,8 +3302,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 (d, m (i, j)); + octave_quit (); + result (i, j) = xmin (d, m (i, j)); } return result; @@ -3322,8 +3322,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), d); + octave_quit (); + result (i, j) = xmin (m (i, j), d); } return result; @@ -3338,7 +3338,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 Matrix (); } @@ -3349,8 +3349,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 (a (i, j), b (i, j)); + octave_quit (); + result (i, j) = xmin (a (i, j), b (i, j)); } return result; @@ -3369,8 +3369,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 (d, m (i, j)); + octave_quit (); + result (i, j) = xmax (d, m (i, j)); } return result; @@ -3389,8 +3389,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), d); + octave_quit (); + result (i, j) = xmax (m (i, j), d); } return result; @@ -3405,7 +3405,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 Matrix (); } @@ -3416,8 +3416,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 (a (i, j), b (i, j)); + octave_quit (); + result (i, j) = xmax (a (i, j), b (i, j)); } return result;
--- a/liboctave/dNDArray.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -46,7 +46,7 @@ #include "bsxfun-defs.cc" NDArray::NDArray (const Array<octave_idx_type>& a, bool zero_based, - bool negative_to_nan) + bool negative_to_nan) { const octave_idx_type *pa = a.fortran_vec (); resize (a.dims ()); @@ -56,34 +56,34 @@ double nan_val = lo_ieee_nan_value (); if (zero_based) - for (octave_idx_type i = 0; i < a.numel (); i++) - { - double val = static_cast<double> - (pa[i] + static_cast<octave_idx_type> (1)); - if (val <= 0) - ptmp[i] = nan_val; - else - ptmp[i] = val; - } + for (octave_idx_type i = 0; i < a.numel (); i++) + { + double val = static_cast<double> + (pa[i] + static_cast<octave_idx_type> (1)); + if (val <= 0) + ptmp[i] = nan_val; + else + ptmp[i] = val; + } else - for (octave_idx_type i = 0; i < a.numel (); i++) - { - double val = static_cast<double> (pa[i]); - if (val <= 0) - ptmp[i] = nan_val; - else - ptmp[i] = val; - } + for (octave_idx_type i = 0; i < a.numel (); i++) + { + double val = static_cast<double> (pa[i]); + if (val <= 0) + ptmp[i] = nan_val; + else + ptmp[i] = val; + } } else { if (zero_based) - for (octave_idx_type i = 0; i < a.numel (); i++) - ptmp[i] = static_cast<double> - (pa[i] + static_cast<octave_idx_type> (1)); + for (octave_idx_type i = 0; i < a.numel (); i++) + ptmp[i] = static_cast<double> + (pa[i] + static_cast<octave_idx_type> (1)); else - for (octave_idx_type i = 0; i < a.numel (); i++) - ptmp[i] = static_cast<double> (pa[i]); + for (octave_idx_type i = 0; i < a.numel (); i++) + ptmp[i] = static_cast<double> (pa[i]); } } @@ -123,7 +123,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; } @@ -153,7 +153,7 @@ // Need to be careful here about the distance between fft's for (octave_idx_type k = 0; k < nloop; k++) octave_fftw::ifft (out + k * stride * n, out + k * stride * n, - n, howmany, stride, dist); + n, howmany, stride, dist); return retval; } @@ -278,17 +278,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; @@ -325,18 +325,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; @@ -362,27 +362,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); } @@ -410,28 +410,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); } @@ -458,27 +458,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); } @@ -505,28 +505,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); } @@ -552,8 +552,8 @@ if (neg_zero) { for (octave_idx_type i = 0; i < nel; i++) - if (lo_ieee_signbit (elem (i))) - return true; + if (lo_ieee_signbit (elem (i))) + return true; } else return mx_inline_any_negative (numel (), data ()); @@ -570,7 +570,7 @@ { double val = elem (i); if (xisnan (val)) - return true; + return true; } return false; @@ -585,7 +585,7 @@ { double val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -600,7 +600,7 @@ { double val = elem (i); if (val != 0 && val != 1) - return true; + return true; } return false; @@ -627,9 +627,9 @@ { double val = elem (i); if (xisnan (val) || D_NINT (val) == val) - continue; + continue; else - return false; + return false; } return true; @@ -656,13 +656,13 @@ double val = elem (i); if (val > max_val) - max_val = val; + max_val = val; if (val < min_val) - min_val = val; + min_val = val; if (D_NINT (val) != val) - return false; + return false; } return true; @@ -678,7 +678,7 @@ double val = elem (i); if (D_NINT (val) != val) - return false; + return false; } return true; @@ -694,8 +694,8 @@ double val = elem (i); if (! (xisnan (val) || xisinf (val)) - && fabs (val) > FLT_MAX) - return true; + && fabs (val) > FLT_MAX) + return true; } return false; @@ -833,22 +833,22 @@ double d = elem (i); if (xisnan (d)) - { - (*current_liboctave_error_handler) - ("invalid conversion from NaN to character"); - return retval; - } + { + (*current_liboctave_error_handler) + ("invalid conversion from NaN to character"); + return retval; + } 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; - retval.elem (i) = static_cast<char>(ival); - } + retval.elem (i) = static_cast<char>(ival); + } } if (rb.numel () == 0) @@ -924,15 +924,15 @@ void NDArray::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 NDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); } @@ -967,13 +967,13 @@ { double tmp; for (octave_idx_type i = 0; i < nel; i++) - { - tmp = octave_read_value<double> (is); - if (is) - a.elem (i) = tmp; - else - goto done; - } + { + tmp = octave_read_value<double> (is); + if (is) + a.elem (i) = tmp; + else + goto done; + } } done:
--- a/liboctave/dRowVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dRowVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,13 +42,13 @@ { F77_RET_T F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const double&, - const double*, const octave_idx_type&, const double*, - const octave_idx_type&, const double&, double*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const double&, + const double*, const octave_idx_type&, const double*, + const octave_idx_type&, const double&, double*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xddot, XDDOT) (const octave_idx_type&, const double*, const octave_idx_type&, - const double*, const octave_idx_type&, double&); + const double*, const octave_idx_type&, double&); } // Row Vector class. @@ -84,7 +84,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; @@ -100,7 +100,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -124,7 +124,7 @@ make_unique (); for (octave_idx_type i = c1; i <= c2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -210,21 +210,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); - double *y = retval.fortran_vec (); + retval.resize (a_nc); + double *y = retval.fortran_vec (); - F77_XFCN (dgemv, DGEMV, (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 (dgemv, DGEMV, (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;
--- a/liboctave/dSparse.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dSparse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -67,66 +67,66 @@ { F77_RET_T F77_FUNC (dgbtrf, DGBTRF) (const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, - double*, const octave_idx_type&, - octave_idx_type*, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + double*, const octave_idx_type&, + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (dgbtrs, DGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const double*, const octave_idx_type&, - const octave_idx_type*, double*, 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 double*, const octave_idx_type&, + const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgbcon, DGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, const octave_idx_type*, const double&, - double&, double*, octave_idx_type*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, double*, + const octave_idx_type&, const octave_idx_type*, const double&, + double&, double*, octave_idx_type*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpbtrf, DPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpbtrs, DPBTRS) (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); + 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_RET_T F77_FUNC (dpbcon, DPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, double*, const octave_idx_type&, - const double&, double&, double*, octave_idx_type*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, double*, const octave_idx_type&, + const double&, double&, double*, octave_idx_type*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dptsv, DPTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, - double*, const octave_idx_type&, octave_idx_type&); + double*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dgtsv, DGTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, - double*, double*, const octave_idx_type&, octave_idx_type&); + double*, double*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dgttrf, DGTTRF) (const octave_idx_type&, double*, double*, double*, double*, - octave_idx_type*, octave_idx_type&); + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (dgttrs, DGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const double*, const double*, - const double*, const double*, const octave_idx_type*, - double *, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const double*, const double*, + const double*, const double*, const octave_idx_type*, + double *, 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&); } @@ -202,7 +202,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)) @@ -226,30 +226,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) == 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) == data(k)) + found = true; + break; + } + } + + if (! found) + return false; + } + } + } return true; } @@ -298,99 +298,99 @@ idx_arg.clear (1, nc); octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - { - double tmp_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.; - - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - double tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (xisnan (tmp_max) || tmp > tmp_max) - { - idx_j = ridx (i); - tmp_max = tmp; - } - - } - - idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; - if (tmp_max != 0.) - nel++; - } + { + double tmp_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.; + + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + double tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (xisnan (tmp_max) || tmp > tmp_max) + { + idx_j = ridx (i); + tmp_max = tmp; + } + + } + + idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; + if (tmp_max != 0.) + nel++; + } result = SparseMatrix (1, nc, nel); octave_idx_type ii = 0; result.xcidx (0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = elem (idx_arg(j), j); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = 0; - } - result.xcidx (j+1) = ii; - - } + { + double 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); - double tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (ix == -1 || tmp > 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); + double tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (ix == -1 || tmp > 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 = SparseMatrix (nr, 1, nel); @@ -398,23 +398,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) = octave_NaN; - result.xridx (ii++) = j; - } - else - { - double 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) = octave_NaN; + result.xridx (ii++) = j; + } + else + { + double tmp = elem (j, idx_arg(j)); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = j; + } + } + } } return result; @@ -447,99 +447,99 @@ idx_arg.clear (1, nc); octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - { - double tmp_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.; - - for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) - { - double tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (xisnan (tmp_min) || tmp < tmp_min) - { - idx_j = ridx (i); - tmp_min = tmp; - } - - } - - idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; - if (tmp_min != 0.) - nel++; - } + { + double tmp_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.; + + for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) + { + double tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (xisnan (tmp_min) || tmp < tmp_min) + { + idx_j = ridx (i); + tmp_min = tmp; + } + + } + + idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; + if (tmp_min != 0.) + nel++; + } result = SparseMatrix (1, nc, nel); octave_idx_type ii = 0; result.xcidx (0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = elem (idx_arg(j), j); - if (tmp != 0.) - { - result.xdata (ii) = tmp; - result.xridx (ii++) = 0; - } - result.xcidx (j+1) = ii; - - } + { + double 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); - double tmp = data (i); - - if (xisnan (tmp)) - continue; - else if (ix == -1 || tmp < 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); + double tmp = data (i); + + if (xisnan (tmp)) + continue; + else if (ix == -1 || tmp < 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 = SparseMatrix (nr, 1, nel); @@ -547,23 +547,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) = octave_NaN; - result.xridx (ii++) = j; - } - else - { - double 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) = octave_NaN; + result.xridx (ii++) = j; + } + else + { + double tmp = elem (j, idx_arg(j)); + if (tmp != 0.) + { + result.xdata (ii) = tmp; + result.xridx (ii++) = j; + } + } + } } return result; @@ -673,8 +673,8 @@ Matrix tmp (nr, nc, atan2 (x, 0.)); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++) - tmp.elem (y.ridx(i), j) = atan2 (x, y.data(i)); + for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++) + tmp.elem (y.ridx(i), j) = atan2 (x, y.data(i)); return SparseMatrix (tmp); } @@ -694,14 +694,14 @@ for (octave_idx_type i = 0; i < nc; i++) { for (octave_idx_type j = x.cidx(i); j < x.cidx(i+1); j++) - { - double tmp = atan2 (x.data(j), y); - if (tmp != 0.) - { - retval.xdata (ii) = tmp; - retval.xridx (ii++) = x.ridx (j); - } - } + { + double tmp = atan2 (x.data(j), y); + if (tmp != 0.) + { + retval.xdata (ii) = tmp; + retval.xridx (ii++) = x.ridx (j); + } + } retval.xcidx (i+1) = ii; } @@ -709,12 +709,12 @@ { SparseMatrix retval2 (nr, nc, ii); for (octave_idx_type i = 0; i < nc+1; i++) - retval2.xcidx (i) = retval.cidx (i); + retval2.xcidx (i) = retval.cidx (i); for (octave_idx_type i = 0; i < ii; i++) - { - retval2.xdata (i) = retval.data (i); - retval2.xridx (i) = retval.ridx (i); - } + { + retval2.xdata (i) = retval.data (i); + retval2.xridx (i) = retval.ridx (i); + } return retval2; } else @@ -735,61 +735,61 @@ octave_idx_type y_nc = y.cols (); if (x_nr != y_nr || x_nc != y_nc) - gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); + gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); else - { - r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); + { + r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); - octave_idx_type jx = 0; - r.cidx (0) = 0; - for (octave_idx_type i = 0 ; i < x_nc ; i++) - { - octave_idx_type ja = x.cidx(i); - octave_idx_type ja_max = x.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 < x_nc ; i++) + { + octave_idx_type ja = x.cidx(i); + octave_idx_type ja_max = x.cidx(i+1); + bool ja_lt_max= ja < ja_max; - octave_idx_type jb = y.cidx(i); - octave_idx_type jb_max = y.cidx(i+1); - bool jb_lt_max = jb < jb_max; + octave_idx_type jb = y.cidx(i); + octave_idx_type jb_max = y.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 && (x.ridx(ja) < y.ridx(jb)))) - { - r.ridx(jx) = x.ridx(ja); - r.data(jx) = atan2 (x.data(ja), 0.); - jx++; - ja++; - ja_lt_max= ja < ja_max; - } - else if (( !ja_lt_max ) || - (jb_lt_max && (y.ridx(jb) < x.ridx(ja)) ) ) - { - jb++; - jb_lt_max= jb < jb_max; - } - else - { - double tmp = atan2 (x.data(ja), y.data(jb)); - if (tmp != 0.) - { + { + r.ridx(jx) = x.ridx(ja); + r.data(jx) = atan2 (x.data(ja), 0.); + jx++; + ja++; + ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (y.ridx(jb) < x.ridx(ja)) ) ) + { + jb++; + jb_lt_max= jb < jb_max; + } + else + { + double tmp = atan2 (x.data(ja), y.data(jb)); + if (tmp != 0.) + { r.data(jx) = tmp; r.ridx(jx) = x.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"); @@ -823,8 +823,8 @@ SparseMatrix SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, - double& rcond, const bool, - const bool calccond) const + double& rcond, const bool, + const bool calccond) const { SparseMatrix retval; @@ -841,35 +841,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 - double *v = retval.data(); - - if (calccond) - { - double dmax = 0., dmin = octave_Inf; - for (octave_idx_type i = 0; i < nr; i++) - { - double tmp = fabs(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 + double *v = retval.data(); + + if (calccond) + { + double dmax = 0., dmin = octave_Inf; + for (octave_idx_type i = 0; i < nr; i++) + { + double tmp = fabs(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; @@ -877,8 +877,8 @@ SparseMatrix SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, - double& rcond, const bool, - const bool calccond) const + double& rcond, const bool, + const bool calccond) const { SparseMatrix retval; @@ -895,255 +895,255 @@ 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 += fabs(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 = SparseMatrix (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++) - { - double 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); - double 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); - double 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 = SparseMatrix (nr, nc, nz2); - - OCTAVE_LOCAL_BUFFER (double, 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++) - { - double 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) - double 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]); - - double 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 += fabs(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 += fabs(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 = SparseMatrix (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++) + { + double 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); + double 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); + double 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 = SparseMatrix (nr, nc, nz2); + + OCTAVE_LOCAL_BUFFER (double, 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++) + { + double 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) + double 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]); + + double 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 += fabs(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; @@ -1154,7 +1154,7 @@ SparseMatrix SparseMatrix::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); SparseMatrix ret; @@ -1174,43 +1174,43 @@ else { if (mattype.is_hermitian()) - { - MatrixType tmp_typ (MatrixType::Upper); - SparseCHOL fact (*this, info, false); - rcond = fact.rcond(); - if (info == 0) - { - double rcond2; - SparseMatrix Q = fact.Q(); - SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, - info, rcond2, true, false); - ret = Q * InvL.transpose() * InvL * Q.transpose(); - } - else - { - // Matrix is either singular or not positive definite - mattype.mark_as_unsymmetric (); - typ = MatrixType::Full; - } - } + { + MatrixType tmp_typ (MatrixType::Upper); + SparseCHOL fact (*this, info, false); + rcond = fact.rcond(); + if (info == 0) + { + double rcond2; + SparseMatrix Q = fact.Q(); + SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, + info, rcond2, true, false); + ret = Q * InvL.transpose() * 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); - SparseLU fact (*this, Qinit, Matrix(), false, false); - rcond = fact.rcond(); - double rcond2; - SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, - info, rcond2, true, false); - SparseMatrix 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); + SparseLU fact (*this, Qinit, Matrix(), false, false); + rcond = fact.rcond(); + double rcond2; + SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, + info, rcond2, true, false); + SparseMatrix InvU = fact.U().tinverse(tmp_typ, info, rcond2, + true, false).transpose(); + ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); + } } return ret; @@ -1255,19 +1255,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; @@ -1284,61 +1284,61 @@ Matrix Info (1, UMFPACK_INFO); double *info = Info.fortran_vec (); int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, - Ax, 0, &Symbolic, control, info); + Ax, 0, &Symbolic, control, info); if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::determinant symbolic factorization failed"); - - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); - - UMFPACK_DNAME (free_symbolic) (&Symbolic) ; - } + { + (*current_liboctave_error_handler) + ("SparseMatrix::determinant symbolic factorization failed"); + + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); + + UMFPACK_DNAME (free_symbolic) (&Symbolic) ; + } else - { - UMFPACK_DNAME (report_symbolic) (Symbolic, control); - - void *Numeric; - status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, - &Numeric, control, info) ; - UMFPACK_DNAME (free_symbolic) (&Symbolic) ; - - rcond = Info (UMFPACK_RCOND); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::determinant numeric factorization failed"); - - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); - - UMFPACK_DNAME (free_numeric) (&Numeric); - } - else - { - UMFPACK_DNAME (report_numeric) (Numeric, control); - - double c10, e10; - - status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric, info); - - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::determinant error calculating determinant"); - - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); - } - else - retval = DET (c10, e10, 10); - - UMFPACK_DNAME (free_numeric) (&Numeric); - } - } + { + UMFPACK_DNAME (report_symbolic) (Symbolic, control); + + void *Numeric; + status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, + &Numeric, control, info) ; + UMFPACK_DNAME (free_symbolic) (&Symbolic) ; + + rcond = Info (UMFPACK_RCOND); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::determinant numeric factorization failed"); + + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); + + UMFPACK_DNAME (free_numeric) (&Numeric); + } + else + { + UMFPACK_DNAME (report_numeric) (Numeric, control); + + double c10, e10; + + status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric, info); + + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::determinant error calculating determinant"); + + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); + } + else + retval = DET (c10, e10, 10); + + UMFPACK_DNAME (free_numeric) (&Numeric); + } + } } #else (*current_liboctave_error_handler) ("UMFPACK not installed"); @@ -1349,8 +1349,8 @@ Matrix SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler, - bool calc_cond) const + double& rcond, solve_singularity_handler, + bool calc_cond) const { Matrix retval; @@ -1371,37 +1371,37 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - retval.resize (nc, b.cols(), 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 = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; - } - else - rcond = 1.; - } + typ == MatrixType::Permuted_Diagonal) + { + retval.resize (nc, b.cols(), 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 = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1409,8 +1409,8 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -1431,67 +1431,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 = SparseMatrix (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_nc; j++) - { - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - { - if (b.ridx(i) >= nm) - break; - retval.xridx (ii) = b.ridx(i); - retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); - } - retval.xcidx(j+1) = ii; - } - else - for (octave_idx_type j = 0; j < b_nc; 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 = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; - } - else - rcond = 1.; - } + typ == MatrixType::Permuted_Diagonal) + { + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nz = b.nnz (); + retval = SparseMatrix (nc, b_nc, b_nz); + + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + if (typ == MatrixType::Diagonal) + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + { + if (b.ridx(i) >= nm) + break; + retval.xridx (ii) = b.ridx(i); + retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); + } + retval.xcidx(j+1) = ii; + } + else + for (octave_idx_type j = 0; j < b_nc; 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 = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1499,8 +1499,8 @@ ComplexMatrix SparseMatrix::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; @@ -1521,37 +1521,37 @@ mattype.info (); if (typ == MatrixType::Diagonal || - typ == MatrixType::Permuted_Diagonal) - { - retval.resize (nc, b.cols(), 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 = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; - } - else - rcond = 1.; - } + typ == MatrixType::Permuted_Diagonal) + { + retval.resize (nc, b.cols(), 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 = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1559,8 +1559,8 @@ SparseComplexMatrix SparseMatrix::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; @@ -1581,67 +1581,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 = fabs(data(i)); - if (tmp > dmax) - dmax = tmp; - if (tmp < dmin) - dmin = tmp; - } - rcond = dmin / dmax; - } - else - rcond = 1.; - } + 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 = fabs(data(i)); + if (tmp > dmax) + dmax = tmp; + if (tmp < dmin) + dmin = tmp; + } + rcond = dmin / dmax; + } + else + rcond = 1.; + } else - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1649,9 +1649,9 @@ Matrix SparseMatrix::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 { Matrix retval; @@ -1672,211 +1672,211 @@ 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 += fabs(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 (double, 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; - } - - double 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.xelem (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.) - { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) - { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - 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.) - { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(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 (double, 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; + } + + double 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.xelem (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.) + { + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + 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.) + { + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -1884,9 +1884,9 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -1907,273 +1907,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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nnz (); - retval = SparseMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Upper) - { - octave_idx_type *perm = mattype.triangular_perm (); - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double 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.) - { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) - { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - // 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.) - { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nz = b.nnz (); + retval = SparseMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Upper) + { + octave_idx_type *perm = mattype.triangular_perm (); + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double 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.) + { + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + // 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.) + { + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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 SparseMatrix::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; @@ -2194,214 +2194,214 @@ 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 += fabs(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, cwork, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - cwork[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - cwork[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (cwork[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(kidx+1)-1); - cwork[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (perm[i], j) = cwork[i]; - } - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) - { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) - cwork[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - cwork[i] = 0.; - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - if (cwork[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(k+1)-1); - cwork[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = cwork[i]; - } - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(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, cwork, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + cwork[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + cwork[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (cwork[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(kidx+1)-1); + cwork[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (perm[i], j) = cwork[i]; + } + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) + cwork[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + cwork[i] = 0.; + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + if (cwork[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(k+1)-1); + cwork[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = cwork[i]; + } + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -2409,9 +2409,9 @@ SparseComplexMatrix SparseMatrix::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; @@ -2432,266 +2432,266 @@ 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 += fabs(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, cwork, 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++) - cwork[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - cwork[b.ridx(i)] = b.data(i); - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - octave_idx_type kidx = perm[k]; - - if (cwork[k] != 0.) - { - if (ridx(cidx(kidx+1)-1) != k || - data(cidx(kidx+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(kidx+1)-1); - cwork[k] = tmp; - for (octave_idx_type i = cidx(kidx); - i < cidx(kidx+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[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 (cwork[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 (cwork[rperm[i]] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = cwork[rperm[i]]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - octave_idx_type iidx = perm[k]; - - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(iidx+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(iidx); - i < cidx(iidx+1)-1; i++) - { - octave_idx_type idx2 = ridx(i); - work[idx2] = work[idx2] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - cwork[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - cwork[b.ridx(i)] = b.data(i); - - for (octave_idx_type k = nc-1; k >= 0; k--) - { - if (cwork[k] != 0.) - { - if (ridx(cidx(k+1)-1) != k || - data(cidx(k+1)-1) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(k+1)-1); - cwork[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = cwork[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k >= 0; k--) - { - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(k+1)-1); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1)-1; i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = 0; i < j+1; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(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, cwork, 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++) + cwork[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + cwork[b.ridx(i)] = b.data(i); + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + octave_idx_type kidx = perm[k]; + + if (cwork[k] != 0.) + { + if (ridx(cidx(kidx+1)-1) != k || + data(cidx(kidx+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(kidx+1)-1); + cwork[k] = tmp; + for (octave_idx_type i = cidx(kidx); + i < cidx(kidx+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[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 (cwork[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 (cwork[rperm[i]] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = cwork[rperm[i]]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + octave_idx_type iidx = perm[k]; + + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(iidx+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(iidx); + i < cidx(iidx+1)-1; i++) + { + octave_idx_type idx2 = ridx(i); + work[idx2] = work[idx2] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + cwork[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + cwork[b.ridx(i)] = b.data(i); + + for (octave_idx_type k = nc-1; k >= 0; k--) + { + if (cwork[k] != 0.) + { + if (ridx(cidx(k+1)-1) != k || + data(cidx(k+1)-1) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(k+1)-1); + cwork[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = cwork[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k >= 0; k--) + { + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(k+1)-1); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1)-1; i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = 0; i < j+1; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -2699,9 +2699,9 @@ Matrix SparseMatrix::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 { Matrix retval; @@ -2722,236 +2722,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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - if (typ == MatrixType::Permuted_Lower) - { - retval.resize (nc, b_nc); - OCTAVE_LOCAL_BUFFER (double, work, nm); - octave_idx_type *perm = mattype.triangular_perm (); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - if (nc > nr) - 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; - i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - 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.) - { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; - i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + if (typ == MatrixType::Permuted_Lower) + { + retval.resize (nc, b_nc); + OCTAVE_LOCAL_BUFFER (double, work, nm); + octave_idx_type *perm = mattype.triangular_perm (); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + if (nc > nr) + 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + 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.) + { + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -2959,9 +2959,9 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -2982,283 +2982,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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nz = b.nnz (); - retval = SparseMatrix (nc, b_nc, b_nz); - retval.xcidx(0) = 0; - octave_idx_type ii = 0; - octave_idx_type x_nz = b_nz; - - if (typ == MatrixType::Permuted_Lower) - { - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - // 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - double atmp = 0; - for (octave_idx_type i = j; i < nr; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (double, 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; - } - - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - // 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.) - { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; - i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nz = b.nnz (); + retval = SparseMatrix (nc, b_nc, b_nz); + retval.xcidx(0) = 0; + octave_idx_type ii = 0; + octave_idx_type x_nz = b_nz; + + if (typ == MatrixType::Permuted_Lower) + { + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + // 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + double atmp = 0; + for (octave_idx_type i = j; i < nr; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (double, 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; + } + + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + // 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.) + { + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -3266,9 +3266,9 @@ ComplexMatrix SparseMatrix::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; @@ -3289,237 +3289,237 @@ 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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - if (typ == MatrixType::Permuted_Lower) - { - retval.resize (nc, b_nc); - OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) - cwork[i] = 0.; - for (octave_idx_type i = 0; i < nr; i++) - cwork[perm[i]] = b(i,j); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (cwork[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 = cwork[k] / data(mini); - cwork[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)]; - cwork[iidx] = cwork[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval (i, j) = cwork[i]; - } - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) - cwork[i] = b(i,j); - for (octave_idx_type i = nr; i < nc; i++) - cwork[i] = 0.; - - for (octave_idx_type k = 0; k < nc; k++) - { - if (cwork[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(k)); - cwork[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[iidx] - tmp * data(i); - } - } - } - - for (octave_idx_type i = 0; i < nc; i++) - retval.xelem (i, j) = cwork[i]; - } - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; - i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + if (typ == MatrixType::Permuted_Lower) + { + retval.resize (nc, b_nc); + OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) + cwork[i] = 0.; + for (octave_idx_type i = 0; i < nr; i++) + cwork[perm[i]] = b(i,j); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (cwork[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 = cwork[k] / data(mini); + cwork[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)]; + cwork[iidx] = cwork[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval (i, j) = cwork[i]; + } + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, cwork, 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++) + cwork[i] = b(i,j); + for (octave_idx_type i = nr; i < nc; i++) + cwork[i] = 0.; + + for (octave_idx_type k = 0; k < nc; k++) + { + if (cwork[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(k)); + cwork[k] = tmp; + for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[iidx] - tmp * data(i); + } + } + } + + for (octave_idx_type i = 0; i < nc; i++) + retval.xelem (i, j) = cwork[i]; + } + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -3527,9 +3527,9 @@ SparseComplexMatrix SparseMatrix::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; @@ -3550,285 +3550,285 @@ 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 += fabs(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, cwork, 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++) - cwork[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - cwork[perm[b.ridx(i)]] = b.data(i); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (cwork[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 = cwork[k] / data(mini); - cwork[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)]; - cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = cwork[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - 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; - } - - double tmp = work[k] / data(mini); - work[k] = tmp; - for (octave_idx_type i = cidx(k); - i < cidx(k+1); i++) - { - if (i == mini) - continue; - - octave_idx_type iidx = perm[ridx(i)]; - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - if (atmp > ainvnorm) - ainvnorm = atmp; - } - rcond = 1. / ainvnorm / anorm; - } - } - else - { - OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nm; i++) - cwork[i] = 0.; - for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - cwork[b.ridx(i)] = b.data(i); - - for (octave_idx_type k = 0; k < nc; k++) - { - if (cwork[k] != 0.) - { - if (ridx(cidx(k)) != k || - data(cidx(k)) == 0.) - { - err = -2; - goto triangular_error; - } - - Complex tmp = cwork[k] / data(cidx(k)); - cwork[k] = tmp; - for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = cwork[i]; - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - - if (calc_cond) - { - // Calculation of 1-norm of inv(*this) - OCTAVE_LOCAL_BUFFER (double, work, nm); - for (octave_idx_type i = 0; i < nm; i++) - work[i] = 0.; - - for (octave_idx_type j = 0; j < nr; j++) - { - work[j] = 1.; - - for (octave_idx_type k = j; k < nc; k++) - { - - if (work[k] != 0.) - { - double tmp = work[k] / data(cidx(k)); - work[k] = tmp; - for (octave_idx_type i = cidx(k)+1; - i < cidx(k+1); i++) - { - octave_idx_type iidx = ridx(i); - work[iidx] = work[iidx] - tmp * data(i); - } - } - } - double atmp = 0; - for (octave_idx_type i = j; i < nc; i++) - { - atmp += fabs(work[i]); - work[i] = 0.; - } - 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) - ("SparseMatrix::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 += fabs(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, cwork, 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++) + cwork[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + cwork[perm[b.ridx(i)]] = b.data(i); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (cwork[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 = cwork[k] / data(mini); + cwork[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)]; + cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = cwork[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + 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; + } + + double tmp = work[k] / data(mini); + work[k] = tmp; + for (octave_idx_type i = cidx(k); + i < cidx(k+1); i++) + { + if (i == mini) + continue; + + octave_idx_type iidx = perm[ridx(i)]; + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + if (atmp > ainvnorm) + ainvnorm = atmp; + } + rcond = 1. / ainvnorm / anorm; + } + } + else + { + OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nm; i++) + cwork[i] = 0.; + for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) + cwork[b.ridx(i)] = b.data(i); + + for (octave_idx_type k = 0; k < nc; k++) + { + if (cwork[k] != 0.) + { + if (ridx(cidx(k)) != k || + data(cidx(k)) == 0.) + { + err = -2; + goto triangular_error; + } + + Complex tmp = cwork[k] / data(cidx(k)); + cwork[k] = tmp; + for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + cwork[iidx] = cwork[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 (cwork[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 (cwork[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = cwork[i]; + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + + if (calc_cond) + { + // Calculation of 1-norm of inv(*this) + OCTAVE_LOCAL_BUFFER (double, work, nm); + for (octave_idx_type i = 0; i < nm; i++) + work[i] = 0.; + + for (octave_idx_type j = 0; j < nr; j++) + { + work[j] = 1.; + + for (octave_idx_type k = j; k < nc; k++) + { + + if (work[k] != 0.) + { + double tmp = work[k] / data(cidx(k)); + work[k] = tmp; + for (octave_idx_type i = cidx(k)+1; + i < cidx(k+1); i++) + { + octave_idx_type iidx = ridx(i); + work[iidx] = work[iidx] - tmp * data(i); + } + } + } + double atmp = 0; + for (octave_idx_type i = j; i < nc; i++) + { + atmp += fabs(work[i]); + work[i] = 0.; + } + 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) + ("SparseMatrix::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; @@ -3836,9 +3836,9 @@ Matrix SparseMatrix::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 { Matrix retval; @@ -3861,125 +3861,125 @@ mattype.info (); if (typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (double, 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); - ii += 2; - } - 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.; - } - - 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); - } - } - - octave_idx_type b_nc = b.cols(); - retval = b; - double *result = retval.fortran_vec (); - - F77_XFCN (dptsv, DPTSV, (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 (double, 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); + ii += 2; + } + 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.; + } + + 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); + } + } + + octave_idx_type b_nc = b.cols(); + retval = b; + double *result = retval.fortran_vec (); + + F77_XFCN (dptsv, DPTSV, (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 (double, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (double, 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 = b; - double *result = retval.fortran_vec (); - - F77_XFCN (dgtsv, DGTSV, (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 (double, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (double, D, nr); + OCTAVE_LOCAL_BUFFER (double, 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 = b; + double *result = retval.fortran_vec (); + + F77_XFCN (dgtsv, DGTSV, (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; @@ -3987,9 +3987,9 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -4013,120 +4013,120 @@ // Note can't treat symmetric case as there is no dpttrf function if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); - OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (double, 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 (dgttrf, DGTTRF, (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.0; - char job = 'N'; - volatile octave_idx_type x_nz = b.nnz (); - octave_idx_type b_nc = b.cols (); - retval = SparseMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, work, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - 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 (dgttrs, DGTTRS, - (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 (double, DU2, nr - 2); + OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (double, D, nr); + OCTAVE_LOCAL_BUFFER (double, 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 (dgttrf, DGTTRF, (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.0; + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, work, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + 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 (dgttrs, DGTTRS, + (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; @@ -4134,9 +4134,9 @@ ComplexMatrix SparseMatrix::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; @@ -4159,126 +4159,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] = data(ii++); - DL[j] = data(ii); - ii += 2; - } - 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.; - } - - 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); - } - } - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols(); - rcond = 1.; - - retval = 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] = data(ii++); + DL[j] = data(ii); + ii += 2; + } + 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.; + } + + 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); + } + } + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols(); + rcond = 1.; + + retval = 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 = 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 = 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; @@ -4286,9 +4286,9 @@ SparseComplexMatrix SparseMatrix::trisolve (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; @@ -4312,152 +4312,152 @@ // Note can't treat symmetric case as there is no dpttrf function if (typ == MatrixType::Tridiagonal || - typ == MatrixType::Tridiagonal_Hermitian) - { - OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); - OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); - OCTAVE_LOCAL_BUFFER (double, D, nr); - OCTAVE_LOCAL_BUFFER (double, 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 (dgttrf, DGTTRF, (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 (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dgttrs, DGTTRS, - (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) - ("SparseMatrix::solve solve failed"); - - err = -1; - break; - } - - F77_XFCN (dgttrs, DGTTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, 1, DL, D, DU, DU2, pipvt, - Bz, 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. || Bz[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = - Complex (Bx[i], Bz[i]); - } - - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - } - } + typ == MatrixType::Tridiagonal_Hermitian) + { + OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); + OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); + OCTAVE_LOCAL_BUFFER (double, D, nr); + OCTAVE_LOCAL_BUFFER (double, 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 (dgttrf, DGTTRF, (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 (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dgttrs, DGTTRS, + (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) + ("SparseMatrix::solve solve failed"); + + err = -1; + break; + } + + F77_XFCN (dgttrs, DGTTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, 1, DL, D, DU, DU2, pipvt, + Bz, 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. || Bz[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = + Complex (Bx[i], Bz[i]); + } + + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + } + } else if (typ != MatrixType::Tridiagonal_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4465,9 +4465,9 @@ Matrix SparseMatrix::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 { Matrix retval; @@ -4487,226 +4487,226 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - Matrix m_band (ldm, nc); - double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpbcon, DPBCON, - (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.; - - if (err == 0) - { - retval = b; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, b_nc, tmp_data, - ldm, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); - - if (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; + Matrix m_band (ldm, nc); + double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DPBCON, + (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.; + + if (err == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, b_nc, tmp_data, + ldm, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); + + if (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; - - Matrix m_band (ldm, nc); - double *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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, - ldm, pipvt, err)); - - // Throw-away extra info LAPACK gives so as to not - // change output. - 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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dgbcon, DGBCON, - (F77_CONST_CHAR_ARG2 (&job, 1), - nc, n_lower, n_upper, tmp_data, ldm, pipvt, - anorm, rcond, pz, piz, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - err = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - err = -2; - - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - } - else - rcond = 1.; - - if (err == 0) - { - retval = b; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - char job = 'N'; - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, b_nc, tmp_data, - ldm, pipvt, result, b.rows(), err - F77_CHAR_ARG_LEN (1))); - } - } - } + { + // 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; + + Matrix m_band (ldm, nc); + double *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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, + ldm, pipvt, err)); + + // Throw-away extra info LAPACK gives so as to not + // change output. + 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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, b_nc, tmp_data, + ldm, pipvt, result, b.rows(), err + F77_CHAR_ARG_LEN (1))); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -4714,9 +4714,9 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -4736,295 +4736,295 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - Matrix m_band (ldm, nc); - double *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 (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, tmp_data, ldm, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - mattype.mark_as_unsymmetric (); - typ = MatrixType::Banded; - rcond = 0.0; - err = 0; - } - else - { - if (calc_cond) - { - Array<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpbcon, DPBCON, - (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.; - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - retval = SparseMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < b_nr; i++) - Bx[i] = b.elem (i, j); - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - double tmp = Bx[i]; - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * - (b_nc - j) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - retval.xdata(ii) = tmp; - retval.xridx(ii++) = i; - } - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + Matrix m_band (ldm, nc); + double *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 (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, tmp_data, ldm, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + mattype.mark_as_unsymmetric (); + typ = MatrixType::Banded; + rcond = 0.0; + err = 0; + } + else + { + if (calc_cond) + { + Array<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DPBCON, + (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.; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + Bx[i] = b.elem (i, j); + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + double tmp = Bx[i]; + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * + (b_nc - j) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + retval.xdata(ii) = tmp; + retval.xridx(ii++) = i; + } + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + } + } + } 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; - - Matrix m_band (ldm, nc); - double *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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dgbcon, DGBCON, - (F77_CONST_CHAR_ARG2 (&job, 1), - nc, n_lower, n_upper, tmp_data, ldm, pipvt, - anorm, rcond, pz, piz, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - err = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - err = -2; - - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - } - else - rcond = 1.; - - if (err == 0) - { - char job = 'N'; - volatile octave_idx_type x_nz = b.nnz (); - octave_idx_type b_nc = b.cols (); - retval = SparseMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, work, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - work[i] = 0.; - for (octave_idx_type i = b.cidx(j); - i < b.cidx(j+1); i++) - work[b.ridx(i)] = b.data(i); - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, work, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - // 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; + + Matrix m_band (ldm, nc); + double *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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, work, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + work[i] = 0.; + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + work[b.ridx(i)] = b.data(i); + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, work, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + // 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; @@ -5032,9 +5032,9 @@ ComplexMatrix SparseMatrix::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; @@ -5054,276 +5054,276 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - Matrix m_band (ldm, nc); - double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpbcon, DPBCON, - (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.; - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - retval.resize (b_nr, b_nc); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bz, b.rows(), err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - retval (i, j) = Complex (Bx[i], Bz[i]); - } - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + Matrix m_band (ldm, nc); + double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DPBCON, + (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.; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + retval.resize (b_nr, b_nc); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bz, b.rows(), err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + retval (i, j) = Complex (Bx[i], Bz[i]); + } + } + } + } if (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; - - Matrix m_band (ldm, nc); - double *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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpbcon, DPBCON, - (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.; - - if (err == 0) - { - char job = 'N'; - octave_idx_type b_nc = b.cols (); - retval.resize (nr,b_nc); - - OCTAVE_LOCAL_BUFFER (double, Bz, nr); - OCTAVE_LOCAL_BUFFER (double, Bx, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - Complex c = b (i, j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bx, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bz, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - for (octave_idx_type i = 0; i < nr; i++) - retval (i, j) = Complex (Bx[i], Bz[i]); - } - } - } - } + { + // 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; + + Matrix m_band (ldm, nc); + double *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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DPBCON, + (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.; + + if (err == 0) + { + char job = 'N'; + octave_idx_type b_nc = b.cols (); + retval.resize (nr,b_nc); + + OCTAVE_LOCAL_BUFFER (double, Bz, nr); + OCTAVE_LOCAL_BUFFER (double, Bx, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + Complex c = b (i, j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bx, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bz, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + for (octave_idx_type i = 0; i < nr; i++) + retval (i, j) = Complex (Bx[i], Bz[i]); + } + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -5331,9 +5331,9 @@ SparseComplexMatrix SparseMatrix::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; @@ -5353,339 +5353,339 @@ mattype.info (); if (typ == MatrixType::Banded_Hermitian) - { - octave_idx_type n_lower = mattype.nlower (); - octave_idx_type ldm = n_lower + 1; - - Matrix m_band (ldm, nc); - double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dpbcon, DPBCON, - (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.; - - if (err == 0) - { - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - retval.xcidx(0) = 0; - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bx, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - err = -1; - break; - } - - F77_XFCN (dpbtrs, DPBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, 1, tmp_data, - ldm, Bz, b_nr, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - err = -1; - break; - } - - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = - Complex (Bx[i], Bz[i]); - } - - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - } - } - } + { + octave_idx_type n_lower = mattype.nlower (); + octave_idx_type ldm = n_lower + 1; + + Matrix m_band (ldm, nc); + double *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 (dpbtrf, DPBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpbcon, DPBCON, + (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.; + + if (err == 0) + { + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + retval.xcidx(0) = 0; + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bx, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + err = -1; + break; + } + + F77_XFCN (dpbtrs, DPBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, 1, tmp_data, + ldm, Bz, b_nr, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + err = -1; + break; + } + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = + Complex (Bx[i], Bz[i]); + } + + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + } + } + } 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; - - Matrix m_band (ldm, nc); - double *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 += fabs(data(i)); - if (atmp > anorm) - anorm = atmp; - } - } - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nr); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (dgbcon, DGBCON, - (F77_CONST_CHAR_ARG2 (&job, 1), - nc, n_lower, n_upper, tmp_data, ldm, pipvt, - anorm, rcond, pz, piz, err - F77_CHAR_ARG_LEN (1))); - - if (err != 0) - err = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - err = -2; - - if (sing_handler) - { - sing_handler (rcond); - mattype.mark_as_rectangular (); - } - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - } - else - rcond = 1.; - - if (err == 0) - { - char job = 'N'; - volatile octave_idx_type x_nz = b.nnz (); - octave_idx_type b_nc = b.cols (); - retval = SparseComplexMatrix (nr, b_nc, x_nz); - retval.xcidx(0) = 0; - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, Bx, nr); - OCTAVE_LOCAL_BUFFER (double, Bz, nr); - - for (volatile octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - Bx[i] = 0.; - Bz[i] = 0.; - } - for (octave_idx_type i = b.cidx(j); - i < b.cidx(j+1); i++) - { - Complex c = b.data(i); - Bx[b.ridx(i)] = std::real (c); - Bz[b.ridx(i)] = std::imag (c); - } - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bx, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - F77_XFCN (dgbtrs, DGBTRS, - (F77_CONST_CHAR_ARG2 (&job, 1), - nr, n_lower, n_upper, 1, tmp_data, - ldm, pipvt, Bz, b.rows (), err - F77_CHAR_ARG_LEN (1))); - - // Count non-zeros in work vector and adjust - // space in retval if needed - octave_idx_type new_nnz = 0; - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - new_nnz++; - - if (ii + new_nnz > x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; - retval.change_capacity (sz); - x_nz = sz; - } - - for (octave_idx_type i = 0; i < nr; i++) - if (Bx[i] != 0. || Bz[i] != 0.) - { - retval.xridx(ii) = i; - retval.xdata(ii++) = - Complex (Bx[i], Bz[i]); - } - retval.xcidx(j+1) = ii; - } - - retval.maybe_compress (); - } - } - } + { + // 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; + + Matrix m_band (ldm, nc); + double *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 += fabs(data(i)); + if (atmp > anorm) + anorm = atmp; + } + } + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + F77_XFCN (dgbtrf, DGBTRF, (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<double> z (3 * nr); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nr); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgbcon, DGBCON, + (F77_CONST_CHAR_ARG2 (&job, 1), + nc, n_lower, n_upper, tmp_data, ldm, pipvt, + anorm, rcond, pz, piz, err + F77_CHAR_ARG_LEN (1))); + + if (err != 0) + err = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + err = -2; + + if (sing_handler) + { + sing_handler (rcond); + mattype.mark_as_rectangular (); + } + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + else + rcond = 1.; + + if (err == 0) + { + char job = 'N'; + volatile octave_idx_type x_nz = b.nnz (); + octave_idx_type b_nc = b.cols (); + retval = SparseComplexMatrix (nr, b_nc, x_nz); + retval.xcidx(0) = 0; + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, Bx, nr); + OCTAVE_LOCAL_BUFFER (double, Bz, nr); + + for (volatile octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + Bx[i] = 0.; + Bz[i] = 0.; + } + for (octave_idx_type i = b.cidx(j); + i < b.cidx(j+1); i++) + { + Complex c = b.data(i); + Bx[b.ridx(i)] = std::real (c); + Bz[b.ridx(i)] = std::imag (c); + } + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bx, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + F77_XFCN (dgbtrs, DGBTRS, + (F77_CONST_CHAR_ARG2 (&job, 1), + nr, n_lower, n_upper, 1, tmp_data, + ldm, pipvt, Bz, b.rows (), err + F77_CHAR_ARG_LEN (1))); + + // Count non-zeros in work vector and adjust + // space in retval if needed + octave_idx_type new_nnz = 0; + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + new_nnz++; + + if (ii + new_nnz > x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; + retval.change_capacity (sz); + x_nz = sz; + } + + for (octave_idx_type i = 0; i < nr; i++) + if (Bx[i] != 0. || Bz[i] != 0.) + { + retval.xridx(ii) = i; + retval.xdata(ii++) = + Complex (Bx[i], Bz[i]); + } + retval.xcidx(j+1) = ii; + } + + retval.maybe_compress (); + } + } + } else if (typ != MatrixType::Banded_Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -5693,8 +5693,8 @@ void * SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, - Matrix &Info, solve_singularity_handler sing_handler, - bool calc_cond) const + Matrix &Info, solve_singularity_handler sing_handler, + bool calc_cond) const { // The return values void *Numeric = 0; @@ -5735,12 +5735,12 @@ Info = Matrix (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) - ("SparseMatrix::solve symbolic factorization failed"); + ("SparseMatrix::solve symbolic factorization failed"); err = -1; UMFPACK_DNAME (report_status) (control, status); @@ -5753,44 +5753,44 @@ UMFPACK_DNAME (report_symbolic) (Symbolic, control); status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, - &Numeric, control, info) ; + &Numeric, control, info) ; UMFPACK_DNAME (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_DNAME (report_numeric) (Numeric, control); - - err = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", - rcond); - - } + rcond_plus_one == 1.0 || xisnan (rcond)) + { + UMFPACK_DNAME (report_numeric) (Numeric, control); + + err = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", + rcond); + + } else if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve numeric factorization failed"); - - UMFPACK_DNAME (report_status) (control, status); - UMFPACK_DNAME (report_info) (control, info); - - err = -1; - } - else - { - UMFPACK_DNAME (report_numeric) (Numeric, control); - } + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve numeric factorization failed"); + + UMFPACK_DNAME (report_status) (control, status); + UMFPACK_DNAME (report_info) (control, info); + + err = -1; + } + else + { + UMFPACK_DNAME (report_numeric) (Numeric, control); + } } if (err != 0) @@ -5805,9 +5805,9 @@ Matrix SparseMatrix::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 { Matrix retval; @@ -5827,193 +5827,193 @@ 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_REAL; - - 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.0; - - 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<double *>(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_REAL; + + 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.0; + + 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<double *>(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) - { - const double *Bx = b.fortran_vec (); - retval.resize (b.rows (), b.cols()); - double *result = retval.fortran_vec (); - 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 double *Ax = data (); - - for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) - { - status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, - Ai, Ax, &result[iidx], &Bx[iidx], - Numeric, control, info); - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - UMFPACK_DNAME (report_status) (control, status); - - err = -1; - - break; - } - } - - UMFPACK_DNAME (report_info) (control, info); - - UMFPACK_DNAME (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) + { + const double *Bx = b.fortran_vec (); + retval.resize (b.rows (), b.cols()); + double *result = retval.fortran_vec (); + 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 double *Ax = data (); + + for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) + { + status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, + Ai, Ax, &result[iidx], &Bx[iidx], + Numeric, control, info); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + UMFPACK_DNAME (report_status) (control, status); + + err = -1; + + break; + } + } + + UMFPACK_DNAME (report_info) (control, info); + + UMFPACK_DNAME (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; @@ -6021,9 +6021,9 @@ SparseMatrix SparseMatrix::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 { SparseMatrix retval; @@ -6043,239 +6043,239 @@ 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_REAL; - - 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_REAL; + + 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 = SparseMatrix (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<double *>(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 = SparseMatrix (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<double *>(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 double *Ax = data (); - - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Xx, 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 = SparseMatrix (b_nr, b_nc, x_nz); - - 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.elem (i, j); - - status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, - Ai, Ax, Xx, Bx, Numeric, control, - info); - if (status < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - UMFPACK_DNAME (report_status) (control, status); - - err = -1; - - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - double 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_DNAME (report_info) (control, info); - - UMFPACK_DNAME (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 double *Ax = data (); + + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Xx, 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 = SparseMatrix (b_nr, b_nc, x_nz); + + 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.elem (i, j); + + status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, + Ai, Ax, Xx, Bx, Numeric, control, + info); + if (status < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + UMFPACK_DNAME (report_status) (control, status); + + err = -1; + + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + double 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_DNAME (report_info) (control, info); + + UMFPACK_DNAME (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; @@ -6283,9 +6283,9 @@ ComplexMatrix SparseMatrix::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; @@ -6305,211 +6305,211 @@ 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_REAL; - - 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.0; - 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_REAL; + + 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.0; + 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 double *Ax = data (); - - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - retval.resize (b_nr, b_nc); - - OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); - - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, - Ai, Ax, Xx, Bx, Numeric, control, - info); - int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, - Ap, Ai, Ax, Xz, Bz, Numeric, - control, info) ; - - if (status < 0 || status2 < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - UMFPACK_DNAME (report_status) (control, status); - - err = -1; - - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - retval (i, j) = Complex (Xx[i], Xz[i]); - } - - UMFPACK_DNAME (report_info) (control, info); - - UMFPACK_DNAME (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 double *Ax = data (); + + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + retval.resize (b_nr, b_nc); + + OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); + + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, + Ai, Ax, Xx, Bx, Numeric, control, + info); + int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, + Ap, Ai, Ax, Xz, Bz, Numeric, + control, info) ; + + if (status < 0 || status2 < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + UMFPACK_DNAME (report_status) (control, status); + + err = -1; + + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + retval (i, j) = Complex (Xx[i], Xz[i]); + } + + UMFPACK_DNAME (report_info) (control, info); + + UMFPACK_DNAME (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; @@ -6517,9 +6517,9 @@ SparseComplexMatrix SparseMatrix::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; @@ -6539,249 +6539,249 @@ 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_REAL; - - 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_REAL; + + 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.0; - 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.0; + 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 double *Ax = data (); - - OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); - - // Take a first guess that the number of non-zero terms - // will be as many as in b - octave_idx_type x_nz = b.nnz (); - octave_idx_type ii = 0; - retval = SparseComplexMatrix (b_nr, b_nc, x_nz); - - OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); - OCTAVE_LOCAL_BUFFER (double, Xz, 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++) - { - Complex c = b (i,j); - Bx[i] = std::real (c); - Bz[i] = std::imag (c); - } - - status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, - Ai, Ax, Xx, Bx, Numeric, control, - info); - int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, - Ap, Ai, Ax, Xz, Bz, Numeric, - control, info) ; - - if (status < 0 || status2 < 0) - { - (*current_liboctave_error_handler) - ("SparseMatrix::solve solve failed"); - - UMFPACK_DNAME (report_status) (control, status); - - err = -1; - - break; - } - - for (octave_idx_type i = 0; i < b_nr; i++) - { - Complex tmp = Complex (Xx[i], Xz[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_DNAME (report_info) (control, info); - - UMFPACK_DNAME (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 double *Ax = data (); + + OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); + + // Take a first guess that the number of non-zero terms + // will be as many as in b + octave_idx_type x_nz = b.nnz (); + octave_idx_type ii = 0; + retval = SparseComplexMatrix (b_nr, b_nc, x_nz); + + OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); + OCTAVE_LOCAL_BUFFER (double, Xz, 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++) + { + Complex c = b (i,j); + Bx[i] = std::real (c); + Bz[i] = std::imag (c); + } + + status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, + Ai, Ax, Xx, Bx, Numeric, control, + info); + int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, + Ap, Ai, Ax, Xz, Bz, Numeric, + control, info) ; + + if (status < 0 || status2 < 0) + { + (*current_liboctave_error_handler) + ("SparseMatrix::solve solve failed"); + + UMFPACK_DNAME (report_status) (control, status); + + err = -1; + + break; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + { + Complex tmp = Complex (Xx[i], Xz[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_DNAME (report_info) (control, info); + + UMFPACK_DNAME (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; @@ -6797,7 +6797,7 @@ Matrix SparseMatrix::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); @@ -6805,15 +6805,15 @@ Matrix SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (mattype, b, info, rcond, 0); } Matrix SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, - double& rcond, solve_singularity_handler sing_handler, - bool singular_fallback) const + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback) const { Matrix retval; int typ = mattype.type (false); @@ -6831,7 +6831,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); @@ -6865,7 +6865,7 @@ SparseMatrix SparseMatrix::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); @@ -6873,16 +6873,16 @@ SparseMatrix SparseMatrix::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); } SparseMatrix SparseMatrix::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 { SparseMatrix retval; int typ = mattype.type (false); @@ -6899,7 +6899,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); @@ -6916,7 +6916,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<SparseMatrix, SparseMatrix, - SparseMatrix> (*this, b, err); + SparseMatrix> (*this, b, err); #endif } @@ -6933,7 +6933,7 @@ ComplexMatrix SparseMatrix::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); @@ -6941,16 +6941,16 @@ ComplexMatrix SparseMatrix::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 SparseMatrix::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); @@ -6967,7 +6967,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); @@ -6984,7 +6984,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<ComplexMatrix, SparseMatrix, - ComplexMatrix> (*this, b, err); + ComplexMatrix> (*this, b, err); #endif } @@ -7001,7 +7001,7 @@ SparseComplexMatrix SparseMatrix::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); @@ -7009,16 +7009,16 @@ SparseComplexMatrix SparseMatrix::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 SparseMatrix::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); @@ -7035,7 +7035,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); @@ -7052,7 +7052,7 @@ retval = qrsolve (*this, b, err); #else retval = dmsolve<SparseComplexMatrix, SparseMatrix, - SparseComplexMatrix> (*this, b, err); + SparseComplexMatrix> (*this, b, err); #endif } @@ -7081,7 +7081,7 @@ ColumnVector SparseMatrix::solve (MatrixType &mattype, 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 (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -7104,14 +7104,14 @@ ComplexColumnVector SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler) const { ComplexMatrix tmp (b); return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -7134,15 +7134,15 @@ Matrix SparseMatrix::solve (const Matrix& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (b, info, rcond, 0); } Matrix SparseMatrix::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); @@ -7158,7 +7158,7 @@ SparseMatrix SparseMatrix::solve (const SparseMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7166,15 +7166,15 @@ SparseMatrix SparseMatrix::solve (const SparseMatrix& b, - octave_idx_type& info, double& rcond) const + octave_idx_type& info, double& rcond) const { return solve (b, info, rcond, 0); } SparseMatrix SparseMatrix::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); @@ -7182,7 +7182,7 @@ ComplexMatrix SparseMatrix::solve (const ComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7190,15 +7190,15 @@ ComplexMatrix SparseMatrix::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 SparseMatrix::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); @@ -7214,7 +7214,7 @@ SparseComplexMatrix SparseMatrix::solve (const SparseComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { double rcond; return solve (b, info, rcond, 0); @@ -7222,15 +7222,15 @@ SparseComplexMatrix SparseMatrix::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 SparseMatrix::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); @@ -7258,7 +7258,7 @@ ColumnVector SparseMatrix::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)); @@ -7281,14 +7281,14 @@ ComplexColumnVector SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, - double& rcond) const + double& rcond) const { return solve (b, info, rcond, 0); } ComplexColumnVector SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const + solve_singularity_handler sing_handler) const { ComplexMatrix tmp (b); return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); @@ -7304,14 +7304,14 @@ if (neg_zero) { for (octave_idx_type i = 0; i < nel; i++) - if (lo_ieee_signbit (data (i))) - return true; + if (lo_ieee_signbit (data (i))) + return true; } else { for (octave_idx_type i = 0; i < nel; i++) - if (data (i) < 0) - return true; + if (data (i) < 0) + return true; } return false; @@ -7326,7 +7326,7 @@ { double val = data (i); if (xisnan (val)) - return true; + return true; } return false; @@ -7341,7 +7341,7 @@ { double val = data (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -7356,7 +7356,7 @@ { double val = data (i); if (val != 0.0 && val != 1.0) - return true; + return true; } return false; @@ -7383,9 +7383,9 @@ { double val = data (i); if (xisnan (val) || D_NINT (val) == val) - continue; + continue; else - return false; + return false; } return true; @@ -7410,13 +7410,13 @@ double val = data (i); if (val > max_val) - max_val = val; + max_val = val; if (val < min_val) - min_val = val; + min_val = val; if (D_NINT (val) != val) - return false; + return false; } return true; @@ -7432,7 +7432,7 @@ double val = data (i); if (val > FLT_MAX || val < FLT_MIN) - return true; + return true; } return false; @@ -7454,15 +7454,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; } @@ -7504,7 +7504,7 @@ else { SPARSE_REDUCTION_OP (SparseMatrix, double, *=, - (cidx(j+1) - cidx(j) < nr ? 0.0 : 1.0), 1.0); + (cidx(j+1) - cidx(j) < nr ? 0.0 : 1.0), 1.0); } } @@ -7526,7 +7526,7 @@ tmp[j] += d * d SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR, - 0.0, 0.0); + 0.0, 0.0); #undef ROW_EXPR #undef COL_EXPR @@ -7575,9 +7575,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_double (os, a.data(i)); - os << "\n"; + os << a.ridx(i) + 1 << " " << j + 1 << " "; + octave_write_double (os, a.data(i)); + os << "\n"; } } @@ -7740,43 +7740,43 @@ { result = SparseMatrix (nr, nc, d); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - { - double tmp = xmin (d, m.data (i)); - if (tmp != 0.) - { - octave_idx_type idx = m.ridx(i) + j * nr; - result.xdata(idx) = tmp; - result.xridx(idx) = m.ridx(i); - } - } + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + { + double tmp = xmin (d, m.data (i)); + if (tmp != 0.) + { + octave_idx_type idx = m.ridx(i) + j * nr; + result.xdata(idx) = tmp; + result.xridx(idx) = m.ridx(i); + } + } } else { octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - if (xmin (d, m.data (i)) != 0.) - nel++; + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + if (xmin (d, m.data (i)) != 0.) + nel++; result = SparseMatrix (nr, nc, nel); octave_idx_type ii = 0; result.xcidx(0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - { - double tmp = xmin (d, m.data (i)); - - if (tmp != 0.) - { - result.xdata(ii) = tmp; - result.xridx(ii++) = m.ridx(i); - } - } - result.xcidx(j+1) = ii; - } + { + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + { + double tmp = xmin (d, m.data (i)); + + if (tmp != 0.) + { + result.xdata(ii) = tmp; + result.xridx(ii++) = m.ridx(i); + } + } + result.xcidx(j+1) = ii; + } } return result; @@ -7802,72 +7802,72 @@ octave_idx_type b_nc = b.cols (); 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 = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); + { + r = SparseMatrix (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)))) - { - double 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)) ) ) - { - double 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 - { - double tmp = xmin (a.data(ja), b.data(jb)); - if (tmp != 0.) - { + { + double 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)) ) ) + { + double 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 + { + double 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"); @@ -7890,43 +7890,43 @@ { result = SparseMatrix (nr, nc, d); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - { - double tmp = xmax (d, m.data (i)); - - if (tmp != 0.) - { - octave_idx_type idx = m.ridx(i) + j * nr; - result.xdata(idx) = tmp; - result.xridx(idx) = m.ridx(i); - } - } + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + { + double tmp = xmax (d, m.data (i)); + + if (tmp != 0.) + { + octave_idx_type idx = m.ridx(i) + j * nr; + result.xdata(idx) = tmp; + result.xridx(idx) = m.ridx(i); + } + } } else { octave_idx_type nel = 0; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - if (xmax (d, m.data (i)) != 0.) - nel++; + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + if (xmax (d, m.data (i)) != 0.) + nel++; result = SparseMatrix (nr, nc, nel); octave_idx_type ii = 0; result.xcidx(0) = 0; for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) - { - double tmp = xmax (d, m.data (i)); - if (tmp != 0.) - { - result.xdata(ii) = tmp; - result.xridx(ii++) = m.ridx(i); - } - } - result.xcidx(j+1) = ii; - } + { + for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) + { + double tmp = xmax (d, m.data (i)); + if (tmp != 0.) + { + result.xdata(ii) = tmp; + result.xridx(ii++) = m.ridx(i); + } + } + result.xcidx(j+1) = ii; + } } return result; @@ -7952,72 +7952,72 @@ octave_idx_type b_nc = b.cols (); 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 = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); + { + r = SparseMatrix (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)))) - { - double 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)) ) ) - { - double 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 - { - double tmp = xmax (a.data(ja), b.data(jb)); - if (tmp != 0.) - { + { + double 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)) ) ) + { + double 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 + { + double 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");
--- a/liboctave/data-conv.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/data-conv.cc Thu Feb 11 12:23:32 2010 -0500 @@ -47,15 +47,15 @@ { \ int sz = BITS / CHAR_BIT; \ if (sizeof (TQ char) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## char; \ + VAL = oct_data_conv::dt_ ## Q ## char; \ else if (sizeof (TQ short) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## short; \ + VAL = oct_data_conv::dt_ ## Q ## short; \ else if (sizeof (TQ int) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## int; \ + VAL = oct_data_conv::dt_ ## Q ## int; \ else if (sizeof (TQ long) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## long; \ + VAL = oct_data_conv::dt_ ## Q ## long; \ else if (sizeof (TQ long long) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## longlong; \ + VAL = oct_data_conv::dt_ ## Q ## longlong; \ else \ VAL = oct_data_conv::dt_unknown; \ } \ @@ -66,13 +66,13 @@ { \ int sz = BITS / CHAR_BIT; \ if (sizeof (TQ char) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## char; \ + VAL = oct_data_conv::dt_ ## Q ## char; \ else if (sizeof (TQ short) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## short; \ + VAL = oct_data_conv::dt_ ## Q ## short; \ else if (sizeof (TQ int) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## int; \ + VAL = oct_data_conv::dt_ ## Q ## int; \ else if (sizeof (TQ long) == sz) \ - VAL = oct_data_conv::dt_ ## Q ## long; \ + VAL = oct_data_conv::dt_ ## Q ## long; \ else \ VAL = oct_data_conv::dt_unknown; \ } \ @@ -84,9 +84,9 @@ { \ int sz = BITS / CHAR_BIT; \ if (sizeof (float) == sz) \ - VAL = oct_data_conv::dt_float; \ + VAL = oct_data_conv::dt_float; \ else if (sizeof (double) == sz) \ - VAL = oct_data_conv::dt_double; \ + VAL = oct_data_conv::dt_double; \ else \ VAL = oct_data_conv::dt_unknown; \ } \ @@ -153,27 +153,27 @@ do \ { \ switch (sizeof (T)) \ - { \ - case 1: \ - retval = dt_ ## U ## int8; \ - break; \ + { \ + case 1: \ + retval = dt_ ## U ## int8; \ + break; \ \ - case 2: \ - retval = dt_ ## U ## int16; \ - break; \ + case 2: \ + retval = dt_ ## U ## int16; \ + break; \ \ - case 4: \ - retval = dt_ ## U ## int32; \ - break; \ + case 4: \ + retval = dt_ ## U ## int32; \ + break; \ \ - case 8: \ - retval = dt_ ## U ## int64; \ - break; \ + case 8: \ + retval = dt_ ## U ## int64; \ + break; \ \ - default: \ - retval = dt_unknown; \ - break; \ - } \ + default: \ + retval = dt_unknown; \ + break; \ + } \ } \ while (0) @@ -240,9 +240,9 @@ else if (s == "float") { if (sizeof (float) == sizeof (double)) - retval = dt_double; + retval = dt_double; else - retval = dt_single; + retval = dt_single; } else if (s == "logical") retval = dt_logical; @@ -279,23 +279,23 @@ size_t len = s.length (); while (pos < len && isdigit (s[pos])) - pos++; + pos++; if (pos > 0) - { - if (s[pos] == '*') - { - block_size = atoi (s.c_str ()); - s = s.substr (pos+1); - } - else - { - (*current_liboctave_error_handler) - ("invalid repeat count in `%s'", str.c_str ()); + { + if (s[pos] == '*') + { + block_size = atoi (s.c_str ()); + s = s.substr (pos+1); + } + else + { + (*current_liboctave_error_handler) + ("invalid repeat count in `%s'", str.c_str ()); - return; - } - } + return; + } + } } pos = s.find ('='); @@ -303,37 +303,37 @@ if (pos != std::string::npos) { if (s[pos+1] == '>') - { - std::string s1; + { + std::string s1; - if (input_is_output) - { - input_is_output = false; + if (input_is_output) + { + input_is_output = false; - s1 = s.substr (1, pos-1); + s1 = s.substr (1, pos-1); - (*current_liboctave_warning_handler) - ("warning: ignoring leading * in fread precision"); - } - else - s1 = s.substr (0, pos); + (*current_liboctave_warning_handler) + ("warning: ignoring leading * in fread precision"); + } + else + s1 = s.substr (0, pos); - input_type = string_to_data_type (s1); - output_type = string_to_data_type (s.substr (pos+2)); - } + input_type = string_to_data_type (s1); + output_type = string_to_data_type (s.substr (pos+2)); + } else - (*current_liboctave_error_handler) - ("fread: invalid precision specified"); + (*current_liboctave_error_handler) + ("fread: invalid precision specified"); } else { if (input_is_output) - s = s.substr (1); + s = s.substr (1); input_type = string_to_data_type (s); if (input_is_output) - output_type = input_type; + output_type = input_type; } } @@ -357,17 +357,17 @@ if (pos > 0) { if (s[pos] == '*') - { - block_size = atoi (s.c_str ()); - s = s.substr (pos+1); - } + { + block_size = atoi (s.c_str ()); + s = s.substr (pos+1); + } else - { - (*current_liboctave_error_handler) - ("invalid repeat count in `%s'", str.c_str ()); + { + (*current_liboctave_error_handler) + ("invalid repeat count in `%s'", str.c_str ()); - return; - } + return; + } } output_type = string_to_data_type (s); @@ -485,14 +485,14 @@ do \ { \ if (len > 0) \ - { \ - OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ - stream.read (reinterpret_cast<char *> (ptr), size * len); \ - if (swap) \ - swap_bytes< size > (ptr, len); \ - for (int i = 0; i < len; i++) \ - data[i] = ptr[i]; \ - } \ + { \ + OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ + stream.read (reinterpret_cast<char *> (ptr), size * len); \ + if (swap) \ + swap_bytes< size > (ptr, len); \ + for (int i = 0; i < len; i++) \ + data[i] = ptr[i]; \ + } \ } \ while (0) @@ -503,14 +503,14 @@ do \ { \ if (len > 0) \ - { \ - char tmp_type = type; \ - stream.write (&tmp_type, 1); \ - OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ - for (int i = 0; i < len; i++) \ - ptr[i] = static_cast <TYPE> (data[i]); \ - stream.write (reinterpret_cast<char *> (ptr), size * len); \ - } \ + { \ + char tmp_type = type; \ + stream.write (&tmp_type, 1); \ + OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ + for (int i = 0; i < len; i++) \ + ptr[i] = static_cast <TYPE> (data[i]); \ + stream.write (reinterpret_cast<char *> (ptr), size * len); \ + } \ } \ while (0) @@ -733,262 +733,262 @@ void do_double_format_conversion (void *data, int len, - oct_mach_info::float_format from_fmt, - oct_mach_info::float_format to_fmt) + oct_mach_info::float_format from_fmt, + oct_mach_info::float_format to_fmt) { switch (to_fmt) { case oct_mach_info::flt_fmt_ieee_little_endian: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_double_to_IEEE_little_double (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_double_to_IEEE_little_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_double_to_IEEE_little_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_double_to_IEEE_little_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_double_to_IEEE_little_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_double_to_IEEE_little_double (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_IEEE_little_double (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_IEEE_little_double (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_ieee_big_endian: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_double_to_IEEE_big_double (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_double_to_IEEE_big_double (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_double_to_IEEE_big_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_double_to_IEEE_big_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_double_to_IEEE_big_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_double_to_IEEE_big_double (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_IEEE_big_double (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_IEEE_big_double (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_vax_d: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_double_to_VAX_D_double (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_double_to_VAX_D_double (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_double_to_VAX_D_double (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_double_to_VAX_D_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - break; + case oct_mach_info::flt_fmt_vax_d: + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_double_to_VAX_D_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_double_to_VAX_D_double (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_VAX_D_double (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_VAX_D_double (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_vax_g: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_double_to_VAX_G_double (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_double_to_VAX_G_double (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_double_to_VAX_G_double (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_double_to_VAX_G_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_double_to_VAX_G_double (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_double_to_VAX_G_double (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - break; + case oct_mach_info::flt_fmt_vax_g: + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_VAX_G_double (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_VAX_G_double (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; default: (*current_liboctave_error_handler) - ("impossible state reached in file `%s' at line %d", - __FILE__, __LINE__); + ("impossible state reached in file `%s' at line %d", + __FILE__, __LINE__); break; } } void do_float_format_conversion (void *data, int len, - oct_mach_info::float_format from_fmt, - oct_mach_info::float_format to_fmt) + oct_mach_info::float_format from_fmt, + oct_mach_info::float_format to_fmt) { switch (to_fmt) { case oct_mach_info::flt_fmt_ieee_little_endian: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_float_to_IEEE_little_float (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_float_to_IEEE_little_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_float_to_IEEE_little_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_float_to_IEEE_little_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_float_to_IEEE_little_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_float_to_IEEE_little_float (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_IEEE_little_float (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_IEEE_little_float (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_ieee_big_endian: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_float_to_IEEE_big_float (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_float_to_IEEE_big_float (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_float_to_IEEE_big_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_float_to_IEEE_big_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_float_to_IEEE_big_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_float_to_IEEE_big_float (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_IEEE_big_float (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_IEEE_big_float (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_vax_d: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_float_to_VAX_D_float (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_float_to_VAX_D_float (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_float_to_VAX_D_float (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_float_to_VAX_D_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - break; + case oct_mach_info::flt_fmt_vax_d: + break; - case oct_mach_info::flt_fmt_vax_g: - VAX_G_float_to_VAX_D_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_g: + VAX_G_float_to_VAX_D_float (data, len); + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_VAX_D_float (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_VAX_D_float (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; case oct_mach_info::flt_fmt_vax_g: switch (from_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - IEEE_little_float_to_VAX_G_float (data, len); - break; + { + case oct_mach_info::flt_fmt_ieee_little_endian: + IEEE_little_float_to_VAX_G_float (data, len); + break; - case oct_mach_info::flt_fmt_ieee_big_endian: - IEEE_big_float_to_VAX_G_float (data, len); - break; + case oct_mach_info::flt_fmt_ieee_big_endian: + IEEE_big_float_to_VAX_G_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_d: - VAX_D_float_to_VAX_G_float (data, len); - break; + case oct_mach_info::flt_fmt_vax_d: + VAX_D_float_to_VAX_G_float (data, len); + break; - case oct_mach_info::flt_fmt_vax_g: - break; + case oct_mach_info::flt_fmt_vax_g: + break; - case oct_mach_info::flt_fmt_cray: - Cray_to_VAX_G_float (data, len); - break; + case oct_mach_info::flt_fmt_cray: + Cray_to_VAX_G_float (data, len); + break; - default: - gripe_unrecognized_float_fmt (); - break; - } + default: + gripe_unrecognized_float_fmt (); + break; + } break; default: (*current_liboctave_error_handler) - ("impossible state reached in file `%s' at line %d", - __FILE__, __LINE__); + ("impossible state reached in file `%s' at line %d", + __FILE__, __LINE__); break; } } void do_float_format_conversion (void *data, size_t sz, int len, - oct_mach_info::float_format from_fmt, - oct_mach_info::float_format to_fmt) + oct_mach_info::float_format from_fmt, + oct_mach_info::float_format to_fmt) { switch (sz) { @@ -1002,8 +1002,8 @@ default: (*current_liboctave_error_handler) - ("impossible state reached in file `%s' at line %d", - __FILE__, __LINE__); + ("impossible state reached in file `%s' at line %d", + __FILE__, __LINE__); break; } } @@ -1011,7 +1011,7 @@ void read_doubles (std::istream& is, double *data, save_type type, int len, - bool swap, oct_mach_info::float_format fmt) + bool swap, oct_mach_info::float_format fmt) { switch (type) { @@ -1041,21 +1041,21 @@ case LS_FLOAT: { - OCTAVE_LOCAL_BUFFER (float, ptr, len); - is.read (reinterpret_cast<char *> (ptr), 4 * len); - do_float_format_conversion (ptr, len, fmt); - for (int i = 0; i < len; i++) - data[i] = ptr[i]; + OCTAVE_LOCAL_BUFFER (float, ptr, len); + is.read (reinterpret_cast<char *> (ptr), 4 * len); + do_float_format_conversion (ptr, len, fmt); + for (int i = 0; i < len; i++) + data[i] = ptr[i]; } break; case LS_DOUBLE: // No conversion necessary. { - is.read (reinterpret_cast<char *> (data), 8 * len); - do_double_format_conversion (data, len, fmt); + is.read (reinterpret_cast<char *> (data), 8 * len); + do_double_format_conversion (data, len, fmt); - for (int i = 0; i < len; i++) - data[i] = __lo_ieee_replace_old_NA (data[i]); + for (int i = 0; i < len; i++) + data[i] = __lo_ieee_replace_old_NA (data[i]); } break; @@ -1067,7 +1067,7 @@ void read_floats (std::istream& is, float *data, save_type type, int len, - bool swap, oct_mach_info::float_format fmt) + bool swap, oct_mach_info::float_format fmt) { switch (type) { @@ -1102,11 +1102,11 @@ case LS_DOUBLE: { - OCTAVE_LOCAL_BUFFER (double, ptr, len); - is.read (reinterpret_cast<char *> (ptr), 8 * len); - do_double_format_conversion (ptr, len, fmt); - for (int i = 0; i < len; i++) - data[i] = ptr[i]; + OCTAVE_LOCAL_BUFFER (double, ptr, len); + is.read (reinterpret_cast<char *> (ptr), 8 * len); + do_double_format_conversion (ptr, len, fmt); + for (int i = 0; i < len; i++) + data[i] = ptr[i]; } break; @@ -1151,15 +1151,15 @@ case LS_DOUBLE: // No conversion necessary. { - char tmp_type = static_cast<char> (type); - os.write (&tmp_type, 1); - os.write (reinterpret_cast <const char *> (data), 8 * len); + char tmp_type = static_cast<char> (type); + os.write (&tmp_type, 1); + os.write (reinterpret_cast <const char *> (data), 8 * len); } break; default: (*current_liboctave_error_handler) - ("unrecognized data format requested"); + ("unrecognized data format requested"); break; } } @@ -1195,9 +1195,9 @@ case LS_FLOAT: // No conversion necessary. { - char tmp_type = static_cast<char> (type); - os.write (&tmp_type, 1); - os.write (reinterpret_cast <const char *> (data), 4 * len); + char tmp_type = static_cast<char> (type); + os.write (&tmp_type, 1); + os.write (reinterpret_cast <const char *> (data), 4 * len); } break; @@ -1207,7 +1207,7 @@ default: (*current_liboctave_error_handler) - ("unrecognized data format requested"); + ("unrecognized data format requested"); break; } }
--- a/liboctave/dbleAEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleAEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -35,18 +35,18 @@ { F77_RET_T F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, double*, 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&, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, const double*, const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } AEPBALANCE::AEPBALANCE (const Matrix& a, bool noperm, bool noscal) @@ -71,8 +71,8 @@ job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B'); F77_XFCN (dgebal, DGEBAL, (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))); } Matrix @@ -91,11 +91,11 @@ char side = 'R'; F77_XFCN (dgebak, DGEBAK, (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/dbleCHOL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,19 +42,19 @@ { 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); + double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpotri, DPOTRI) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + double*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dpocon, DPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - double*, const octave_idx_type&, const double&, - double&, double*, octave_idx_type*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + double*, const octave_idx_type&, const double&, + double&, double*, octave_idx_type*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); #ifdef HAVE_QRUPDATE F77_RET_T @@ -112,8 +112,8 @@ anorm = xnorm (a, 1); F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), - n, h, n, info - F77_CHAR_ARG_LEN (1))); + n, h, n, info + F77_CHAR_ARG_LEN (1))); xrcond = 0.0; if (info > 0) @@ -128,11 +128,11 @@ Array<octave_idx_type> iz (n); octave_idx_type *piz = iz.fortran_vec (); F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, piz, dpocon_info - F77_CHAR_ARG_LEN (1))); + n, anorm, xrcond, pz, piz, dpocon_info + F77_CHAR_ARG_LEN (1))); if (dpocon_info != 0) - info = -1; + info = -1; } return info; @@ -155,21 +155,21 @@ double *v = tmp.fortran_vec(); if (info == 0) - { - F77_XFCN (dpotri, DPOTRI, (F77_CONST_CHAR_ARG2 ("U", 1), n, - v, n, info - F77_CHAR_ARG_LEN (1))); + { + F77_XFCN (dpotri, DPOTRI, (F77_CONST_CHAR_ARG2 ("U", 1), n, + v, 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 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) = tmp.xelem (j, i); + 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) = tmp.xelem (j, i); - retval = tmp; - } + retval = tmp; + } } else (*current_liboctave_error_handler) ("chol2inv requires square matrix");
--- a/liboctave/dbleGEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleGEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -37,27 +37,27 @@ { F77_RET_T F77_FUNC (dggbal, DGGBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type& N, - double* A, const octave_idx_type& LDA, double* 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); + double* A, const octave_idx_type& LDA, double* 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 GEPBALANCE::init (const Matrix& a, const Matrix& 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 (dggbal, DGGBAL, (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/dbleHESS.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleHESS.cc Thu Feb 11 12:23:32 2010 -0500 @@ -33,27 +33,27 @@ { F77_RET_T F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, double*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgehrd, DGEHRD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - double*, const octave_idx_type&, double*, double*, - const octave_idx_type&, octave_idx_type&); + double*, const octave_idx_type&, double*, double*, + const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dorghr, DORGHR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - double*, const octave_idx_type&, double*, double*, - const octave_idx_type&, octave_idx_type&); + double*, const octave_idx_type&, double*, double*, + const octave_idx_type&, octave_idx_type&); 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); } octave_idx_type @@ -84,8 +84,8 @@ double *pscale = scale.fortran_vec (); F77_XFCN (dgebal, DGEBAL, (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<double> tau (n-1); double *ptau = tau.fortran_vec (); @@ -94,20 +94,20 @@ double *pwork = work.fortran_vec (); F77_XFCN (dgehrd, DGEHRD, (n, ilo, ihi, h, n, ptau, pwork, - lwork, info)); + lwork, info)); unitary_hess_mat = hess_mat; double *z = unitary_hess_mat.fortran_vec (); F77_XFCN (dorghr, DORGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + lwork, info)); F77_XFCN (dgebak, DGEBAK, (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 :-)), please let @@ -116,7 +116,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/dbleLU.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -45,7 +45,7 @@ { F77_RET_T F77_FUNC (dgetrf, DGETRF) (const octave_idx_type&, const octave_idx_type&, double*, - 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/dbleQR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,11 +42,11 @@ { F77_RET_T F77_FUNC (dgeqrf, DGEQRF) (const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, - double*, double*, const octave_idx_type&, octave_idx_type&); + double*, double*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (dorgqr, DORGQR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, double*, double*, const octave_idx_type&, octave_idx_type&); + const octave_idx_type&, double*, double*, 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 = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (double, work, lwork); F77_XFCN (dorgqr, DORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, work, lwork, info)); @@ -298,7 +298,7 @@ OCTAVE_LOCAL_BUFFER (double, w, kmax); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; ColumnVector utmp = u.column (jsi(i)); F77_XFCN (dqrinc, DQRINC, (m, n + ii, std::min (kmax, k + ii), q.fortran_vec (), q.rows (), @@ -321,7 +321,7 @@ { OCTAVE_LOCAL_BUFFER (double, w, k); F77_XFCN (dqrdec, DQRDEC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, w)); + r.fortran_vec (), r.rows (), j + 1, w)); if (k < m) { @@ -358,7 +358,7 @@ OCTAVE_LOCAL_BUFFER (double, w, k); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; F77_XFCN (dqrdec, DQRDEC, (m, n - ii, k == m ? k : k - ii, q.fortran_vec (), q.rows (), r.fortran_vec (), r.rows (), js(ii) + 1, w)); @@ -394,7 +394,7 @@ RowVector utmp = u; OCTAVE_LOCAL_BUFFER (double, w, k); F77_XFCN (dqrinr, DQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), + r.fortran_vec (), r.rows (), j + 1, utmp.fortran_vec (), w)); } @@ -414,7 +414,7 @@ { OCTAVE_LOCAL_BUFFER (double, w, 2*m); F77_XFCN (dqrder, DQRDER, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, + r.fortran_vec (), r.rows (), j + 1, w)); q.resize (m - 1, m - 1);
--- a/liboctave/dbleQRP.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleQRP.cc Thu Feb 11 12:23:32 2010 -0500 @@ -36,7 +36,7 @@ { F77_RET_T F77_FUNC (dgeqp3, DGEQP3) (const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type*, double*, double*, + const octave_idx_type&, octave_idx_type*, double*, double*, const octave_idx_type&, octave_idx_type&); }
--- a/liboctave/dbleSCHUR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleSCHUR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -35,16 +35,16 @@ { F77_RET_T F77_FUNC (dgeesx, DGEESX) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - SCHUR::select_function, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, - double*, double*, double*, const octave_idx_type&, - double&, double&, double*, const octave_idx_type&, - octave_idx_type*, const octave_idx_type&, 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, + SCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&, + double*, double*, double*, const octave_idx_type&, + double&, double&, double*, const octave_idx_type&, + octave_idx_type*, const octave_idx_type&, 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 @@ -128,14 +128,14 @@ octave_idx_type *piwork = iwork.fortran_vec (); F77_XFCN (dgeesx, DGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, - pwork, lwork, piwork, liwork, 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, pwr, pwi, q, n, rconde, rcondv, + pwork, lwork, piwork, liwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); return info; }
--- a/liboctave/dbleSVD.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dbleSVD.cc Thu Feb 11 12:23:32 2010 -0500 @@ -34,13 +34,13 @@ { F77_RET_T F77_FUNC (dgesvd, DGESVD) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, double*, - const octave_idx_type&, 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&, const octave_idx_type&, double*, + const octave_idx_type&, 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); } Matrix @@ -49,7 +49,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("SVD: U not computed because type == SVD::sigma_only"); + ("SVD: U not computed because type == SVD::sigma_only"); return Matrix (); } else @@ -62,7 +62,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("SVD: V not computed because type == SVD::sigma_only"); + ("SVD: V not computed because type == SVD::sigma_only"); return Matrix (); } else @@ -141,21 +141,21 @@ octave_idx_type m1 = std::max (m, one), nrow_vt1 = std::max (nrow_vt, one); F77_XFCN (dgesvd, DGESVD, (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, 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, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (dgesvd, DGESVD, (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, 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, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (! (jobv == 'N' || jobv == 'O')) right_sm = right_sm.transpose ();
--- a/liboctave/dir-ops.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/dir-ops.cc Thu Feb 11 12:23:32 2010 -0500 @@ -56,12 +56,12 @@ dir = static_cast<void *> (opendir (fullname.c_str ())); if (dir) - fail = false; + fail = false; else - { - using namespace std; - errmsg = strerror (errno); - } + { + using namespace std; + errmsg = strerror (errno); + } } else errmsg = "dir_entry::open: empty file name"; @@ -81,12 +81,12 @@ struct dirent *dir_ent; while ((dir_ent = readdir (static_cast<DIR *> (dir)))) - { - if (dir_ent) - dirlist.push_back (dir_ent->d_name); - else - break; - } + { + if (dir_ent) + dirlist.push_back (dir_ent->d_name); + else + break; + } retval = string_vector (dirlist); }
--- a/liboctave/eigs-base.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/eigs-base.cc Thu Feb 11 12:23:32 2010 -0500 @@ -54,82 +54,82 @@ { F77_RET_T F77_FUNC (dsaupd, DSAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const double&, - double*, const octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type*, - octave_idx_type*, double*, double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const double&, + double*, const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type*, + 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 (dseupd, DSEUPD) (const int&, F77_CONST_CHAR_ARG_DECL, - octave_idx_type*, double*, double*, - const octave_idx_type&, const double&, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const double&, double*, const octave_idx_type&, - double*, const octave_idx_type&, octave_idx_type*, - octave_idx_type*, double*, double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + octave_idx_type*, double*, double*, + const octave_idx_type&, const double&, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const double&, double*, const octave_idx_type&, + double*, const octave_idx_type&, octave_idx_type*, + octave_idx_type*, double*, double*, + 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 (dnaupd, DNAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - octave_idx_type&, const double&, - double*, const octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type*, - octave_idx_type*, double*, double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, + octave_idx_type&, const double&, + double*, const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type*, + 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 (dneupd, DNEUPD) (const int&, F77_CONST_CHAR_ARG_DECL, - octave_idx_type*, double*, double*, - double*, const octave_idx_type&, const double&, - const double&, double*, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - octave_idx_type&, const double&, double*, - const octave_idx_type&, double*, - const octave_idx_type&, octave_idx_type*, - octave_idx_type*, double*, double*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + octave_idx_type*, double*, double*, + double*, const octave_idx_type&, const double&, + const double&, double*, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, + octave_idx_type&, const double&, double*, + const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type*, + octave_idx_type*, double*, double*, + 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 (znaupd, ZNAUPD) (octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const double&, - Complex*, const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type*, - octave_idx_type*, Complex*, Complex*, - const octave_idx_type&, double *, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const double&, + Complex*, const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type*, + octave_idx_type*, Complex*, Complex*, + const octave_idx_type&, double *, octave_idx_type& + F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (zneupd, ZNEUPD) (const int&, F77_CONST_CHAR_ARG_DECL, - octave_idx_type*, Complex*, Complex*, - const octave_idx_type&, const Complex&, - Complex*, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const double&, - Complex*, const octave_idx_type&, Complex*, - const octave_idx_type&, octave_idx_type*, - octave_idx_type*, Complex*, Complex*, - const octave_idx_type&, double *, octave_idx_type& - F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + octave_idx_type*, Complex*, Complex*, + const octave_idx_type&, const Complex&, + Complex*, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const double&, + Complex*, const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type*, + octave_idx_type*, Complex*, Complex*, + const octave_idx_type&, double *, octave_idx_type& + F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const double&, - const double*, const octave_idx_type&, const double*, - const octave_idx_type&, const double&, double*, - const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const double&, + const double*, const octave_idx_type&, const double*, + const octave_idx_type&, const double&, double*, + const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T @@ -148,7 +148,7 @@ static octave_idx_type lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, - ComplexMatrix&); + ComplexMatrix&); static octave_idx_type lusolve (const Matrix&, const Matrix&, Matrix&); @@ -158,7 +158,7 @@ static ComplexMatrix ltsolve (const SparseComplexMatrix&, const ColumnVector&, - const ComplexMatrix&); + const ComplexMatrix&); static Matrix ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&,); @@ -218,11 +218,11 @@ { retval.resize (n, b_nc); for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < n; i++) - retval.elem(static_cast<octave_idx_type>(qv[i]), j) = - tmp.elem(i,j); - } + { + for (octave_idx_type i = 0; i < n; i++) + retval.elem(static_cast<octave_idx_type>(qv[i]), j) = + tmp.elem(i,j); + } } return retval; @@ -243,7 +243,7 @@ for (octave_idx_type j = 0; j < b_nc; j++) { for (octave_idx_type i = 0; i < n; i++) - retval.elem(i,j) = m.elem(static_cast<octave_idx_type>(qv[i]), j); + retval.elem(i,j) = m.elem(static_cast<octave_idx_type>(qv[i]), j); } return U.solve (utyp, retval, err, rcond, 0); } @@ -270,14 +270,14 @@ octave_idx_type nc = m.cols (); F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), - nr, nc, 1.0, m.data (), nr, - x, 1, 0.0, y, 1 - F77_CHAR_ARG_LEN (1))); + nr, nc, 1.0, m.data (), nr, + x, 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable error in dgemv"); + ("eigs: unrecoverable error in dgemv"); return false; } else @@ -286,7 +286,7 @@ static bool vector_product (const SparseComplexMatrix& m, const Complex* x, - Complex* y) + Complex* y) { octave_idx_type nc = m.cols (); @@ -307,14 +307,14 @@ octave_idx_type nc = m.cols (); F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), - nr, nc, 1.0, m.data (), nr, - x, 1, 0.0, y, 1 - F77_CHAR_ARG_LEN (1))); + nr, nc, 1.0, m.data (), nr, + x, 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable error in zgemv"); + ("eigs: unrecoverable error in zgemv"); return false; } else @@ -336,7 +336,7 @@ b = bt.transpose(); permB = ColumnVector(n); for (octave_idx_type i = 0; i < n; i++) - permB(i) = i; + permB(i) = i; return true; } } @@ -373,14 +373,14 @@ b = bt.hermitian(); permB = ColumnVector(n); for (octave_idx_type i = 0; i < n; i++) - permB(i) = i; + permB(i) = i; return true; } } static bool make_cholb (SparseComplexMatrix& b, SparseComplexMatrix& bt, - ColumnVector& permB) + ColumnVector& permB) { octave_idx_type info; SparseComplexCHOL fact (b, info, false); @@ -398,9 +398,9 @@ static bool LuAminusSigmaB (const SparseMatrix &m, const SparseMatrix &b, - bool cholB, const ColumnVector& permB, double sigma, - SparseMatrix &L, SparseMatrix &U, octave_idx_type *P, - octave_idx_type *Q) + bool cholB, const ColumnVector& permB, double sigma, + SparseMatrix &L, SparseMatrix &U, octave_idx_type *P, + octave_idx_type *Q) { bool have_b = ! b.is_empty (); octave_idx_type n = m.rows(); @@ -411,44 +411,44 @@ if (have_b) { if (cholB) - { - if (permB.length()) - { - SparseMatrix tmp(n,n,n); - for (octave_idx_type i = 0; i < n; i++) - { - tmp.xcidx(i) = i; - tmp.xridx(i) = - static_cast<octave_idx_type>(permB(i)); - tmp.xdata(i) = 1; - } - tmp.xcidx(n) = n; - - AminusSigmaB = AminusSigmaB - sigma * tmp * - b.transpose() * b * tmp.transpose(); - } - else - AminusSigmaB = AminusSigmaB - sigma * - b.transpose() * b; - } + { + if (permB.length()) + { + SparseMatrix tmp(n,n,n); + for (octave_idx_type i = 0; i < n; i++) + { + tmp.xcidx(i) = i; + tmp.xridx(i) = + static_cast<octave_idx_type>(permB(i)); + tmp.xdata(i) = 1; + } + tmp.xcidx(n) = n; + + AminusSigmaB = AminusSigmaB - sigma * tmp * + b.transpose() * b * tmp.transpose(); + } + else + AminusSigmaB = AminusSigmaB - sigma * + b.transpose() * b; + } else - AminusSigmaB = AminusSigmaB - sigma * b; + AminusSigmaB = AminusSigmaB - sigma * b; } else { SparseMatrix sigmat (n, n, n); - // Create sigma * speye(n,n) - sigmat.xcidx (0) = 0; - for (octave_idx_type i = 0; i < n; i++) - { - sigmat.xdata(i) = sigma; - sigmat.xridx(i) = i; - sigmat.xcidx(i+1) = i + 1; - } - - AminusSigmaB = AminusSigmaB - sigmat; - } + // Create sigma * speye(n,n) + sigmat.xcidx (0) = 0; + for (octave_idx_type i = 0; i < n; i++) + { + sigmat.xdata(i) = sigma; + sigmat.xridx(i) = i; + sigmat.xcidx(i+1) = i + 1; + } + + AminusSigmaB = AminusSigmaB - sigmat; + } SparseLU fact (AminusSigmaB); @@ -470,14 +470,14 @@ { double d = 0.; if (U.xcidx(j+1) > U.xcidx(j) && - U.xridx (U.xcidx(j+1)-1) == j) - d = std::abs (U.xdata (U.xcidx(j+1)-1)); + U.xridx (U.xcidx(j+1)-1) == j) + d = std::abs (U.xdata (U.xcidx(j+1)-1)); if (xisnan (minU) || d < minU) - minU = d; + minU = d; if (xisnan (maxU) || d > maxU) - maxU = d; + maxU = d; } double rcond = (minU / maxU); @@ -486,9 +486,9 @@ if (rcond_plus_one == 1.0 || xisnan (rcond)) { (*current_liboctave_warning_handler) - ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); + ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); (*current_liboctave_warning_handler) - (" an eigenvalue. Convergence is not guaranteed"); + (" an eigenvalue. Convergence is not guaranteed"); } return true; @@ -496,9 +496,9 @@ static bool LuAminusSigmaB (const Matrix &m, const Matrix &b, - bool cholB, const ColumnVector& permB, double sigma, - Matrix &L, Matrix &U, octave_idx_type *P, - octave_idx_type *Q) + bool cholB, const ColumnVector& permB, double sigma, + Matrix &L, Matrix &U, octave_idx_type *P, + octave_idx_type *Q) { bool have_b = ! b.is_empty (); octave_idx_type n = m.cols(); @@ -509,32 +509,32 @@ if (have_b) { if (cholB) - { - Matrix tmp = sigma * b.transpose() * b; - const double *pB = permB.fortran_vec(); - double *p = AminusSigmaB.fortran_vec(); - - if (permB.length()) - { - for (octave_idx_type j = 0; - j < b.cols(); j++) - for (octave_idx_type i = 0; - i < b.rows(); i++) - *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), - static_cast<octave_idx_type>(pB[j])); - } - else - AminusSigmaB = AminusSigmaB - tmp; - } + { + Matrix tmp = sigma * b.transpose() * b; + const double *pB = permB.fortran_vec(); + double *p = AminusSigmaB.fortran_vec(); + + if (permB.length()) + { + for (octave_idx_type j = 0; + j < b.cols(); j++) + for (octave_idx_type i = 0; + i < b.rows(); i++) + *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), + static_cast<octave_idx_type>(pB[j])); + } + else + AminusSigmaB = AminusSigmaB - tmp; + } else - AminusSigmaB = AminusSigmaB - sigma * b; + AminusSigmaB = AminusSigmaB - sigma * b; } else { double *p = AminusSigmaB.fortran_vec(); for (octave_idx_type i = 0; i < n; i++) - p[i*(n+1)] -= sigma; + p[i*(n+1)] -= sigma; } LU fact (AminusSigmaB); @@ -551,10 +551,10 @@ { double d = std::abs (U.xelem(j,j)); if (xisnan (minU) || d < minU) - minU = d; + minU = d; if (xisnan (maxU) || d > maxU) - maxU = d; + maxU = d; } double rcond = (minU / maxU); @@ -563,9 +563,9 @@ if (rcond_plus_one == 1.0 || xisnan (rcond)) { (*current_liboctave_warning_handler) - ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); + ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); (*current_liboctave_warning_handler) - (" an eigenvalue. Convergence is not guaranteed"); + (" an eigenvalue. Convergence is not guaranteed"); } return true; @@ -573,9 +573,9 @@ static bool LuAminusSigmaB (const SparseComplexMatrix &m, const SparseComplexMatrix &b, - bool cholB, const ColumnVector& permB, Complex sigma, - SparseComplexMatrix &L, SparseComplexMatrix &U, - octave_idx_type *P, octave_idx_type *Q) + bool cholB, const ColumnVector& permB, Complex sigma, + SparseComplexMatrix &L, SparseComplexMatrix &U, + octave_idx_type *P, octave_idx_type *Q) { bool have_b = ! b.is_empty (); octave_idx_type n = m.rows(); @@ -586,27 +586,27 @@ if (have_b) { if (cholB) - { - if (permB.length()) - { - SparseMatrix tmp(n,n,n); - for (octave_idx_type i = 0; i < n; i++) - { - tmp.xcidx(i) = i; - tmp.xridx(i) = - static_cast<octave_idx_type>(permB(i)); - tmp.xdata(i) = 1; - } - tmp.xcidx(n) = n; - - AminusSigmaB = AminusSigmaB - tmp * b.hermitian() * b * - tmp.transpose() * sigma; - } - else - AminusSigmaB = AminusSigmaB - sigma * b.hermitian() * b; - } + { + if (permB.length()) + { + SparseMatrix tmp(n,n,n); + for (octave_idx_type i = 0; i < n; i++) + { + tmp.xcidx(i) = i; + tmp.xridx(i) = + static_cast<octave_idx_type>(permB(i)); + tmp.xdata(i) = 1; + } + tmp.xcidx(n) = n; + + AminusSigmaB = AminusSigmaB - tmp * b.hermitian() * b * + tmp.transpose() * sigma; + } + else + AminusSigmaB = AminusSigmaB - sigma * b.hermitian() * b; + } else - AminusSigmaB = AminusSigmaB - sigma * b; + AminusSigmaB = AminusSigmaB - sigma * b; } else { @@ -615,11 +615,11 @@ // Create sigma * speye(n,n) sigmat.xcidx (0) = 0; for (octave_idx_type i = 0; i < n; i++) - { - sigmat.xdata(i) = sigma; - sigmat.xridx(i) = i; - sigmat.xcidx(i+1) = i + 1; - } + { + sigmat.xdata(i) = sigma; + sigmat.xridx(i) = i; + sigmat.xcidx(i+1) = i + 1; + } AminusSigmaB = AminusSigmaB - sigmat; } @@ -644,14 +644,14 @@ { double d = 0.; if (U.xcidx(j+1) > U.xcidx(j) && - U.xridx (U.xcidx(j+1)-1) == j) - d = std::abs (U.xdata (U.xcidx(j+1)-1)); + U.xridx (U.xcidx(j+1)-1) == j) + d = std::abs (U.xdata (U.xcidx(j+1)-1)); if (xisnan (minU) || d < minU) - minU = d; + minU = d; if (xisnan (maxU) || d > maxU) - maxU = d; + maxU = d; } double rcond = (minU / maxU); @@ -660,9 +660,9 @@ if (rcond_plus_one == 1.0 || xisnan (rcond)) { (*current_liboctave_warning_handler) - ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); + ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); (*current_liboctave_warning_handler) - (" an eigenvalue. Convergence is not guaranteed"); + (" an eigenvalue. Convergence is not guaranteed"); } return true; @@ -670,9 +670,9 @@ static bool LuAminusSigmaB (const ComplexMatrix &m, const ComplexMatrix &b, - bool cholB, const ColumnVector& permB, Complex sigma, - ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P, - octave_idx_type *Q) + bool cholB, const ColumnVector& permB, Complex sigma, + ComplexMatrix &L, ComplexMatrix &U, octave_idx_type *P, + octave_idx_type *Q) { bool have_b = ! b.is_empty (); octave_idx_type n = m.cols(); @@ -683,32 +683,32 @@ if (have_b) { if (cholB) - { - ComplexMatrix tmp = sigma * b.hermitian() * b; - const double *pB = permB.fortran_vec(); - Complex *p = AminusSigmaB.fortran_vec(); - - if (permB.length()) - { - for (octave_idx_type j = 0; - j < b.cols(); j++) - for (octave_idx_type i = 0; - i < b.rows(); i++) - *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), - static_cast<octave_idx_type>(pB[j])); - } - else - AminusSigmaB = AminusSigmaB - tmp; - } + { + ComplexMatrix tmp = sigma * b.hermitian() * b; + const double *pB = permB.fortran_vec(); + Complex *p = AminusSigmaB.fortran_vec(); + + if (permB.length()) + { + for (octave_idx_type j = 0; + j < b.cols(); j++) + for (octave_idx_type i = 0; + i < b.rows(); i++) + *p++ -= tmp.xelem (static_cast<octave_idx_type>(pB[i]), + static_cast<octave_idx_type>(pB[j])); + } + else + AminusSigmaB = AminusSigmaB - tmp; + } else - AminusSigmaB = AminusSigmaB - sigma * b; + AminusSigmaB = AminusSigmaB - sigma * b; } else { Complex *p = AminusSigmaB.fortran_vec(); for (octave_idx_type i = 0; i < n; i++) - p[i*(n+1)] -= sigma; + p[i*(n+1)] -= sigma; } ComplexLU fact (AminusSigmaB); @@ -725,10 +725,10 @@ { double d = std::abs (U.xelem(j,j)); if (xisnan (minU) || d < minU) - minU = d; + minU = d; if (xisnan (maxU) || d > maxU) - maxU = d; + maxU = d; } double rcond = (minU / maxU); @@ -737,9 +737,9 @@ if (rcond_plus_one == 1.0 || xisnan (rcond)) { (*current_liboctave_warning_handler) - ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); + ("eigs: 'A - sigma*B' is singular, indicating sigma is exactly"); (*current_liboctave_warning_handler) - (" an eigenvalue. Convergence is not guaranteed"); + (" an eigenvalue. Convergence is not guaranteed"); } return true; @@ -748,12 +748,12 @@ template <class M> octave_idx_type EigsRealSymmetricMatrix (const M& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const M& _b, - ColumnVector &permB, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const M& _b, + ColumnVector &permB, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -772,7 +772,7 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } @@ -787,7 +787,7 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -796,24 +796,24 @@ p = k * 2; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k < 1 || k > n - 2) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -821,27 +821,27 @@ { // Check the we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && @@ -849,14 +849,14 @@ typ != "SI") { (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + ("eigs: unrecognized sigma value"); return -1; } if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") { (*current_liboctave_error_handler) - ("eigs: invalid sigma value for real symmetric problem"); + ("eigs: invalid sigma value for real symmetric problem"); return -1; } @@ -865,25 +865,25 @@ // See Note 3 dsaupd note3 = true; if (cholB) - { - bt = b; - b = b.transpose(); - if (permB.length() == 0) - { - permB = ColumnVector(n); - for (octave_idx_type i = 0; i < n; i++) - permB(i) = i; - } - } + { + bt = b; + b = b.transpose(); + if (permB.length() == 0) + { + permB = ColumnVector(n); + for (octave_idx_type i = 0; i < n; i++) + permB(i) = i; + } + } else - { - if (! make_cholb(b, bt, permB)) - { - (*current_liboctave_error_handler) - ("eigs: The matrix B is not positive definite"); - return -1; - } - } + { + if (! make_cholb(b, bt, permB)) + { + (*current_liboctave_error_handler) + ("eigs: The matrix B is not positive definite"); + return -1; + } + } } Array<octave_idx_type> ip (11); @@ -917,66 +917,66 @@ do { F77_FUNC (dsaupd, DSAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dsaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dsaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - Matrix mtmp (n,1); - for (octave_idx_type i = 0; i < n; i++) - mtmp(i,0) = workd[i + iptr(0) - 1]; - - mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); - - for (octave_idx_type i = 0; i < n; i++) - workd[i+iptr(1)-1] = mtmp(i,0); - } - else if (!vector_product (m, workd + iptr(0) - 1, - workd + iptr(1) - 1)) - break; - } + { + if (have_b) + { + Matrix mtmp (n,1); + for (octave_idx_type i = 0; i < n; i++) + mtmp(i,0) = workd[i + iptr(0) - 1]; + + mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); + + for (octave_idx_type i = 0; i < n; i++) + workd[i+iptr(1)-1] = mtmp(i,0); + } + else if (!vector_product (m, workd + iptr(0) - 1, + workd + iptr(1) - 1)) + break; + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -1008,59 +1008,59 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dseupd"); + ("eigs: unrecoverable exception encountered in dseupd"); return -1; } else { if (info2 == 0) - { - octave_idx_type k2 = k / 2; - if (typ != "SM" && typ != "BE") - { - for (octave_idx_type i = 0; i < k2; i++) - { - double dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - } - - if (rvec) - { - if (typ != "SM" && typ != "BE") - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - } - - if (note3) - eig_vec = ltsolve(b, permB, eig_vec); - } - } + { + octave_idx_type k2 = k / 2; + if (typ != "SM" && typ != "BE") + { + for (octave_idx_type i = 0; i < k2; i++) + { + double dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + } + + if (rvec) + { + if (typ != "SM" && typ != "BE") + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + } + + if (note3) + eig_vec = ltsolve(b, permB, eig_vec); + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dseupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dseupd", info2); + return -1; + } } return ip(4); @@ -1069,12 +1069,12 @@ template <class M> octave_idx_type EigsRealSymmetricMatrixShift (const M& m, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const M& _b, - ColumnVector &permB, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const M& _b, + ColumnVector &permB, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -1090,15 +1090,15 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } // FIXME: The "SM" type for mode 1 seems unstable though faster!! //if (! std::abs (sigma)) // return EigsRealSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val, - // _b, permB, resid, os, tol, rvec, cholB, - // disp, maxit); + // _b, permB, resid, os, tol, rvec, cholB, + // disp, maxit); if (resid.is_empty()) { @@ -1111,15 +1111,15 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1-1).\n" + " Use 'eig(full(A))' instead"); return -1; } @@ -1128,16 +1128,16 @@ p = k * 2; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -1145,26 +1145,26 @@ { // Check the we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } char bmat = 'I'; @@ -1210,110 +1210,110 @@ do { F77_FUNC (dsaupd, DSAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dsaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dsaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - if (ido == -1) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - vector_product (m, workd+iptr(0)-1, dtmp); - - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = dtmp[P[i]]; - - lusolve (L, U, tmp); - - double *ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - else if (ido == 2) - vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); - else - { - double *ip2 = workd+iptr(2)-1; - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - else - { - if (ido == 2) - { - for (octave_idx_type i = 0; i < n; i++) - workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; - } - else - { - double *ip2 = workd+iptr(0)-1; - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - } + { + if (have_b) + { + if (ido == -1) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + vector_product (m, workd+iptr(0)-1, dtmp); + + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = dtmp[P[i]]; + + lusolve (L, U, tmp); + + double *ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + else if (ido == 2) + vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); + else + { + double *ip2 = workd+iptr(2)-1; + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + else + { + if (ido == 2) + { + for (octave_idx_type i = 0; i < n; i++) + workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; + } + else + { + double *ip2 = workd+iptr(0)-1; + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -1328,7 +1328,7 @@ // avoid problems. Array<octave_idx_type> s (p); octave_idx_type *sel = s.fortran_vec (); - + eig_vec.resize (n, k); double *z = eig_vec.fortran_vec (); @@ -1345,50 +1345,50 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dseupd"); + ("eigs: unrecoverable exception encountered in dseupd"); return -1; } else { if (info2 == 0) - { - octave_idx_type k2 = k / 2; - for (octave_idx_type i = 0; i < k2; i++) - { - double dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - - if (rvec) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - } - } + { + octave_idx_type k2 = k / 2; + for (octave_idx_type i = 0; i < k2; i++) + { + double dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + + if (rvec) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dseupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dseupd", info2); + return -1; + } } return ip(4); @@ -1396,12 +1396,12 @@ octave_idx_type EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, - const std::string &_typ, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool /* cholB */, int disp, int maxit) + const std::string &_typ, double sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool /* cholB */, int disp, int maxit) { std::string typ (_typ); bool have_sigma = (sigma ? true : false); @@ -1420,7 +1420,7 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -1429,48 +1429,48 @@ p = k * 2; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } if (! have_sigma) { if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && - typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && - typ != "SI") - (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && + typ != "SI") + (*current_liboctave_error_handler) + ("eigs: unrecognized sigma value"); if (typ == "LI" || typ == "SI" || typ == "LR" || typ == "SR") - { - (*current_liboctave_error_handler) - ("eigs: invalid sigma value for real symmetric problem"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: invalid sigma value for real symmetric problem"); + return -1; + } if (typ == "SM") - { - typ = "LM"; - sigma = 0.; - mode = 3; - } + { + typ = "LM"; + sigma = 0.; + mode = 3; + } } else if (! std::abs (sigma)) typ = "SM"; @@ -1511,67 +1511,67 @@ do { F77_FUNC (dsaupd, DSAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dsaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dsaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - double *ip2 = workd + iptr(0) - 1; - ColumnVector x(n); - - for (octave_idx_type i = 0; i < n; i++) - x(i) = *ip2++; - - ColumnVector y = fun (x, err); - - if (err) - return false; - - ip2 = workd + iptr(1) - 1; - for (octave_idx_type i = 0; i < n; i++) - *ip2++ = y(i); - } + { + double *ip2 = workd + iptr(0) - 1; + ColumnVector x(n); + + for (octave_idx_type i = 0; i < n; i++) + x(i) = *ip2++; + + ColumnVector y = fun (x, err); + + if (err) + return false; + + ip2 = workd + iptr(1) - 1; + for (octave_idx_type i = 0; i < n; i++) + *ip2++ = y(i); + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -1586,7 +1586,7 @@ // avoid problems. Array<octave_idx_type> s (p); octave_idx_type *sel = s.fortran_vec (); - + eig_vec.resize (n, k); double *z = eig_vec.fortran_vec (); @@ -1603,56 +1603,56 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dseupd"); + ("eigs: unrecoverable exception encountered in dseupd"); return -1; } else { if (info2 == 0) - { - octave_idx_type k2 = k / 2; - if (typ != "SM" && typ != "BE") - { - for (octave_idx_type i = 0; i < k2; i++) - { - double dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - } - - if (rvec) - { - if (typ != "SM" && typ != "BE") - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - } - } - } + { + octave_idx_type k2 = k / 2; + if (typ != "SM" && typ != "BE") + { + for (octave_idx_type i = 0; i < k2; i++) + { + double dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + } + + if (rvec) + { + if (typ != "SM" && typ != "BE") + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + } + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dseupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dseupd", info2); + return -1; + } } return ip(4); @@ -1661,12 +1661,12 @@ template <class M> octave_idx_type EigsRealNonSymmetricMatrix (const M& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const M& _b, - ColumnVector &permB, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const M& _b, + ColumnVector &permB, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -1686,7 +1686,7 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } @@ -1701,7 +1701,7 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -1710,24 +1710,24 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -1735,27 +1735,27 @@ { // Check the we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && @@ -1763,14 +1763,14 @@ typ != "SI") { (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + ("eigs: unrecognized sigma value"); return -1; } if (typ == "LA" || typ == "SA" || typ == "BE") { (*current_liboctave_error_handler) - ("eigs: invalid sigma value for unsymmetric problem"); + ("eigs: invalid sigma value for unsymmetric problem"); return -1; } @@ -1779,25 +1779,25 @@ // See Note 3 dsaupd note3 = true; if (cholB) - { - bt = b; - b = b.transpose(); - if (permB.length() == 0) - { - permB = ColumnVector(n); - for (octave_idx_type i = 0; i < n; i++) - permB(i) = i; - } - } + { + bt = b; + b = b.transpose(); + if (permB.length() == 0) + { + permB = ColumnVector(n); + for (octave_idx_type i = 0; i < n; i++) + permB(i) = i; + } + } else - { - if (! make_cholb(b, bt, permB)) - { - (*current_liboctave_error_handler) - ("eigs: The matrix B is not positive definite"); - return -1; - } - } + { + if (! make_cholb(b, bt, permB)) + { + (*current_liboctave_error_handler) + ("eigs: The matrix B is not positive definite"); + return -1; + } + } } Array<octave_idx_type> ip (11); @@ -1831,66 +1831,66 @@ do { F77_FUNC (dnaupd, DNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dnaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dnaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - Matrix mtmp (n,1); - for (octave_idx_type i = 0; i < n; i++) - mtmp(i,0) = workd[i + iptr(0) - 1]; - - mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); - - for (octave_idx_type i = 0; i < n; i++) - workd[i+iptr(1)-1] = mtmp(i,0); - } - else if (!vector_product (m, workd + iptr(0) - 1, - workd + iptr(1) - 1)) - break; - } + { + if (have_b) + { + Matrix mtmp (n,1); + for (octave_idx_type i = 0; i < n; i++) + mtmp(i,0) = workd[i + iptr(0) - 1]; + + mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); + + for (octave_idx_type i = 0; i < n; i++) + workd[i+iptr(1)-1] = mtmp(i,0); + } + else if (!vector_product (m, workd + iptr(0) - 1, + workd + iptr(1) - 1)) + break; + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dnaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dnaupd", info); + return -1; + } + break; + } } while (1); @@ -1925,7 +1925,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dneupd"); + ("eigs: unrecoverable exception encountered in dneupd"); return -1; } else @@ -1934,87 +1934,87 @@ Complex *d = eig_val.fortran_vec (); if (info2 == 0) - { - octave_idx_type jj = 0; - for (octave_idx_type i = 0; i < k+1; i++) - { - if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) - jj++; - else - d [i-jj] = Complex (dr[i], di[i]); - } - if (jj == 0 && !rvec) - for (octave_idx_type i = 0; i < k; i++) - d[i] = d[i+1]; - - octave_idx_type k2 = k / 2; - for (octave_idx_type i = 0; i < k2; i++) - { - Complex dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - eig_val.resize(k); - - if (rvec) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - - eig_vec.resize (n, k); - octave_idx_type i = 0; - while (i < k) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (i+1) * n; - if (std::imag(eig_val(i)) == 0) - { - for (octave_idx_type j = 0; j < n; j++) - eig_vec(j,i) = - Complex(z[j+off1],0.); - i++; - } - else - { - for (octave_idx_type j = 0; j < n; j++) - { - eig_vec(j,i) = - Complex(z[j+off1],z[j+off2]); - if (i < k - 1) - eig_vec(j,i+1) = - Complex(z[j+off1],-z[j+off2]); - } - i+=2; - } - } - - if (note3) - eig_vec = ltsolve(M (b), permB, eig_vec); - } - } + { + octave_idx_type jj = 0; + for (octave_idx_type i = 0; i < k+1; i++) + { + if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) + jj++; + else + d [i-jj] = Complex (dr[i], di[i]); + } + if (jj == 0 && !rvec) + for (octave_idx_type i = 0; i < k; i++) + d[i] = d[i+1]; + + octave_idx_type k2 = k / 2; + for (octave_idx_type i = 0; i < k2; i++) + { + Complex dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + eig_val.resize(k); + + if (rvec) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + + eig_vec.resize (n, k); + octave_idx_type i = 0; + while (i < k) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (i+1) * n; + if (std::imag(eig_val(i)) == 0) + { + for (octave_idx_type j = 0; j < n; j++) + eig_vec(j,i) = + Complex(z[j+off1],0.); + i++; + } + else + { + for (octave_idx_type j = 0; j < n; j++) + { + eig_vec(j,i) = + Complex(z[j+off1],z[j+off2]); + if (i < k - 1) + eig_vec(j,i+1) = + Complex(z[j+off1],-z[j+off2]); + } + i+=2; + } + } + + if (note3) + eig_vec = ltsolve(M (b), permB, eig_vec); + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dneupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dneupd", info2); + return -1; + } } return ip(4); @@ -2023,13 +2023,13 @@ template <class M> octave_idx_type EigsRealNonSymmetricMatrixShift (const M& m, double sigmar, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const M& _b, - ColumnVector &permB, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const M& _b, + ColumnVector &permB, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -2046,15 +2046,15 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } // FIXME: The "SM" type for mode 1 seems unstable though faster!! //if (! std::abs (sigmar)) // return EigsRealNonSymmetricMatrix (m, "SM", k, p, info, eig_vec, eig_val, - // _b, permB, resid, os, tol, rvec, cholB, - // disp, maxit); + // _b, permB, resid, os, tol, rvec, cholB, + // disp, maxit); if (resid.is_empty()) { @@ -2067,7 +2067,7 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -2076,24 +2076,24 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -2101,26 +2101,26 @@ { // Check that we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } char bmat = 'I'; @@ -2166,110 +2166,110 @@ do { F77_FUNC (dnaupd, DNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dsaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dsaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - if (ido == -1) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - vector_product (m, workd+iptr(0)-1, dtmp); - - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = dtmp[P[i]]; - - lusolve (L, U, tmp); - - double *ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - else if (ido == 2) - vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); - else - { - double *ip2 = workd+iptr(2)-1; - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - else - { - if (ido == 2) - { - for (octave_idx_type i = 0; i < n; i++) - workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; - } - else - { - double *ip2 = workd+iptr(0)-1; - Matrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - } + { + if (have_b) + { + if (ido == -1) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + vector_product (m, workd+iptr(0)-1, dtmp); + + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = dtmp[P[i]]; + + lusolve (L, U, tmp); + + double *ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + else if (ido == 2) + vector_product (b, workd+iptr(0)-1, workd+iptr(1)-1); + else + { + double *ip2 = workd+iptr(2)-1; + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + else + { + if (ido == 2) + { + for (octave_idx_type i = 0; i < n; i++) + workd[iptr(0) + i - 1] = workd[iptr(1) + i - 1]; + } + else + { + double *ip2 = workd+iptr(0)-1; + Matrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -2284,7 +2284,7 @@ // avoid problems. Array<octave_idx_type> s (p); octave_idx_type *sel = s.fortran_vec (); - + Matrix eig_vec2 (n, k + 1); double *z = eig_vec2.fortran_vec (); @@ -2304,7 +2304,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dneupd"); + ("eigs: unrecoverable exception encountered in dneupd"); return -1; } else @@ -2313,84 +2313,84 @@ Complex *d = eig_val.fortran_vec (); if (info2 == 0) - { - octave_idx_type jj = 0; - for (octave_idx_type i = 0; i < k+1; i++) - { - if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) - jj++; - else - d [i-jj] = Complex (dr[i], di[i]); - } - if (jj == 0 && !rvec) - for (octave_idx_type i = 0; i < k; i++) - d[i] = d[i+1]; - - octave_idx_type k2 = k / 2; - for (octave_idx_type i = 0; i < k2; i++) - { - Complex dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - eig_val.resize(k); - - if (rvec) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - - eig_vec.resize (n, k); - octave_idx_type i = 0; - while (i < k) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (i+1) * n; - if (std::imag(eig_val(i)) == 0) - { - for (octave_idx_type j = 0; j < n; j++) - eig_vec(j,i) = - Complex(z[j+off1],0.); - i++; - } - else - { - for (octave_idx_type j = 0; j < n; j++) - { - eig_vec(j,i) = - Complex(z[j+off1],z[j+off2]); - if (i < k - 1) - eig_vec(j,i+1) = - Complex(z[j+off1],-z[j+off2]); - } - i+=2; - } - } - } - } + { + octave_idx_type jj = 0; + for (octave_idx_type i = 0; i < k+1; i++) + { + if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) + jj++; + else + d [i-jj] = Complex (dr[i], di[i]); + } + if (jj == 0 && !rvec) + for (octave_idx_type i = 0; i < k; i++) + d[i] = d[i+1]; + + octave_idx_type k2 = k / 2; + for (octave_idx_type i = 0; i < k2; i++) + { + Complex dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + eig_val.resize(k); + + if (rvec) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + + eig_vec.resize (n, k); + octave_idx_type i = 0; + while (i < k) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (i+1) * n; + if (std::imag(eig_val(i)) == 0) + { + for (octave_idx_type j = 0; j < n; j++) + eig_vec(j,i) = + Complex(z[j+off1],0.); + i++; + } + else + { + for (octave_idx_type j = 0; j < n; j++) + { + eig_vec(j,i) = + Complex(z[j+off1],z[j+off2]); + if (i < k - 1) + eig_vec(j,i+1) = + Complex(z[j+off1],-z[j+off2]); + } + i+=2; + } + } + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dneupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dneupd", info2); + return -1; + } } return ip(4); @@ -2398,12 +2398,12 @@ octave_idx_type EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, - const std::string &_typ, double sigmar, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, ColumnVector &resid, - std::ostream& os, double tol, int rvec, - bool /* cholB */, int disp, int maxit) + const std::string &_typ, double sigmar, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, ColumnVector &resid, + std::ostream& os, double tol, int rvec, + bool /* cholB */, int disp, int maxit) { std::string typ (_typ); bool have_sigma = (sigmar ? true : false); @@ -2423,7 +2423,7 @@ if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -2432,24 +2432,24 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -2457,24 +2457,24 @@ if (! have_sigma) { if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && - typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && - typ != "SI") - (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && + typ != "SI") + (*current_liboctave_error_handler) + ("eigs: unrecognized sigma value"); if (typ == "LA" || typ == "SA" || typ == "BE") - { - (*current_liboctave_error_handler) - ("eigs: invalid sigma value for unsymmetric problem"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: invalid sigma value for unsymmetric problem"); + return -1; + } if (typ == "SM") - { - typ = "LM"; - sigmar = 0.; - mode = 3; - } + { + typ = "LM"; + sigmar = 0.; + mode = 3; + } } else if (! std::abs (sigmar)) typ = "SM"; @@ -2515,66 +2515,66 @@ do { F77_FUNC (dnaupd, DNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dnaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in dnaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - double *ip2 = workd + iptr(0) - 1; - ColumnVector x(n); - - for (octave_idx_type i = 0; i < n; i++) - x(i) = *ip2++; - - ColumnVector y = fun (x, err); - - if (err) - return false; - - ip2 = workd + iptr(1) - 1; - for (octave_idx_type i = 0; i < n; i++) - *ip2++ = y(i); - } + { + double *ip2 = workd + iptr(0) - 1; + ColumnVector x(n); + + for (octave_idx_type i = 0; i < n; i++) + x(i) = *ip2++; + + ColumnVector y = fun (x, err); + + if (err) + return false; + + ip2 = workd + iptr(1) - 1; + for (octave_idx_type i = 0; i < n; i++) + *ip2++ = y(i); + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -2609,7 +2609,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in dneupd"); + ("eigs: unrecoverable exception encountered in dneupd"); return -1; } else @@ -2618,84 +2618,84 @@ Complex *d = eig_val.fortran_vec (); if (info2 == 0) - { - octave_idx_type jj = 0; - for (octave_idx_type i = 0; i < k+1; i++) - { - if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) - jj++; - else - d [i-jj] = Complex (dr[i], di[i]); - } - if (jj == 0 && !rvec) - for (octave_idx_type i = 0; i < k; i++) - d[i] = d[i+1]; - - octave_idx_type k2 = k / 2; - for (octave_idx_type i = 0; i < k2; i++) - { - Complex dtmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = dtmp; - } - eig_val.resize(k); - - if (rvec) - { - OCTAVE_LOCAL_BUFFER (double, dtmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - dtmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = dtmp[j]; - } - - eig_vec.resize (n, k); - octave_idx_type i = 0; - while (i < k) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (i+1) * n; - if (std::imag(eig_val(i)) == 0) - { - for (octave_idx_type j = 0; j < n; j++) - eig_vec(j,i) = - Complex(z[j+off1],0.); - i++; - } - else - { - for (octave_idx_type j = 0; j < n; j++) - { - eig_vec(j,i) = - Complex(z[j+off1],z[j+off2]); - if (i < k - 1) - eig_vec(j,i+1) = - Complex(z[j+off1],-z[j+off2]); - } - i+=2; - } - } - } - } + { + octave_idx_type jj = 0; + for (octave_idx_type i = 0; i < k+1; i++) + { + if (dr[i] == 0.0 && di[i] == 0.0 && jj == 0) + jj++; + else + d [i-jj] = Complex (dr[i], di[i]); + } + if (jj == 0 && !rvec) + for (octave_idx_type i = 0; i < k; i++) + d[i] = d[i+1]; + + octave_idx_type k2 = k / 2; + for (octave_idx_type i = 0; i < k2; i++) + { + Complex dtmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = dtmp; + } + eig_val.resize(k); + + if (rvec) + { + OCTAVE_LOCAL_BUFFER (double, dtmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + dtmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = dtmp[j]; + } + + eig_vec.resize (n, k); + octave_idx_type i = 0; + while (i < k) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (i+1) * n; + if (std::imag(eig_val(i)) == 0) + { + for (octave_idx_type j = 0; j < n; j++) + eig_vec(j,i) = + Complex(z[j+off1],0.); + i++; + } + else + { + for (octave_idx_type j = 0; j < n; j++) + { + eig_vec(j,i) = + Complex(z[j+off1],z[j+off2]); + if (i < k - 1) + eig_vec(j,i+1) = + Complex(z[j+off1],-z[j+off2]); + } + i+=2; + } + } + } + } else - { - (*current_liboctave_error_handler) - ("eigs: error %d in dneupd", info2); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: error %d in dneupd", info2); + return -1; + } } return ip(4); @@ -2704,13 +2704,13 @@ template <class M> octave_idx_type EigsComplexNonSymmetricMatrix (const M& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const M& _b, - ColumnVector &permB, - ComplexColumnVector &cresid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const M& _b, + ColumnVector &permB, + ComplexColumnVector &cresid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -2729,7 +2729,7 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } @@ -2741,14 +2741,14 @@ Array<double> ri (octave_rand::vector(n)); cresid = ComplexColumnVector (n); for (octave_idx_type i = 0; i < n; i++) - cresid(i) = Complex(rr(i),ri(i)); + cresid(i) = Complex(rr(i),ri(i)); octave_rand::distribution(rand_dist); } if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -2757,24 +2757,24 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -2782,27 +2782,27 @@ { // Check the we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && @@ -2810,14 +2810,14 @@ typ != "SI") { (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + ("eigs: unrecognized sigma value"); return -1; } if (typ == "LA" || typ == "SA" || typ == "BE") { (*current_liboctave_error_handler) - ("eigs: invalid sigma value for complex problem"); + ("eigs: invalid sigma value for complex problem"); return -1; } @@ -2826,25 +2826,25 @@ // See Note 3 dsaupd note3 = true; if (cholB) - { - bt = b; - b = b.hermitian(); - if (permB.length() == 0) - { - permB = ColumnVector(n); - for (octave_idx_type i = 0; i < n; i++) - permB(i) = i; - } - } + { + bt = b; + b = b.hermitian(); + if (permB.length() == 0) + { + permB = ColumnVector(n); + for (octave_idx_type i = 0; i < n; i++) + permB(i) = i; + } + } else - { - if (! make_cholb(b, bt, permB)) - { - (*current_liboctave_error_handler) - ("eigs: The matrix B is not positive definite"); - return -1; - } - } + { + if (! make_cholb(b, bt, permB)) + { + (*current_liboctave_error_handler) + ("eigs: The matrix B is not positive definite"); + return -1; + } + } } Array<octave_idx_type> ip (11); @@ -2869,7 +2869,7 @@ octave_idx_type ido = 0; int iter = 0; octave_idx_type lwork = p * (3 * p + 5); - + OCTAVE_LOCAL_BUFFER (Complex, v, n * p); OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); @@ -2879,65 +2879,65 @@ do { F77_FUNC (znaupd, ZNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, rwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, rwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in znaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in znaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - ComplexMatrix mtmp (n,1); - for (octave_idx_type i = 0; i < n; i++) - mtmp(i,0) = workd[i + iptr(0) - 1]; - mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); - for (octave_idx_type i = 0; i < n; i++) - workd[i+iptr(1)-1] = mtmp(i,0); - - } - else if (!vector_product (m, workd + iptr(0) - 1, - workd + iptr(1) - 1)) - break; - } + { + if (have_b) + { + ComplexMatrix mtmp (n,1); + for (octave_idx_type i = 0; i < n; i++) + mtmp(i,0) = workd[i + iptr(0) - 1]; + mtmp = utsolve(bt, permB, m * ltsolve(b, permB, mtmp)); + for (octave_idx_type i = 0; i < n; i++) + workd[i+iptr(1)-1] = mtmp(i,0); + + } + else if (!vector_product (m, workd + iptr(0) - 1, + workd + iptr(1) - 1)) + break; + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in znaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in znaupd", info); + return -1; + } + break; + } } while (1); @@ -2971,7 +2971,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in zneupd"); + ("eigs: unrecoverable exception encountered in zneupd"); return -1; } @@ -2979,43 +2979,43 @@ { octave_idx_type k2 = k / 2; for (octave_idx_type i = 0; i < k2; i++) - { - Complex ctmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = ctmp; - } + { + Complex ctmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = ctmp; + } eig_val.resize(k); if (rvec) - { - OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - ctmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = ctmp[j]; - } - - if (note3) - eig_vec = ltsolve(b, permB, eig_vec); - } + { + OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + ctmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = ctmp[j]; + } + + if (note3) + eig_vec = ltsolve(b, permB, eig_vec); + } } else { (*current_liboctave_error_handler) - ("eigs: error %d in zneupd", info2); + ("eigs: error %d in zneupd", info2); return -1; } @@ -3025,14 +3025,14 @@ template <class M> octave_idx_type EigsComplexNonSymmetricMatrixShift (const M& m, Complex sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const M& _b, - ColumnVector &permB, - ComplexColumnVector &cresid, - std::ostream& os, double tol, int rvec, - bool cholB, int disp, int maxit) + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const M& _b, + ColumnVector &permB, + ComplexColumnVector &cresid, + std::ostream& os, double tol, int rvec, + bool cholB, int disp, int maxit) { M b(_b); octave_idx_type n = m.cols (); @@ -3048,15 +3048,15 @@ if (have_b && (m.rows() != b.rows() || m.rows() != b.cols())) { (*current_liboctave_error_handler) - ("eigs: B must be square and the same size as A"); + ("eigs: B must be square and the same size as A"); return -1; } // FIXME: The "SM" type for mode 1 seems unstable though faster!! //if (! std::abs (sigma)) // return EigsComplexNonSymmetricMatrix (m, "SM", k, p, info, eig_vec, - // eig_val, _b, permB, cresid, os, tol, - // rvec, cholB, disp, maxit); + // eig_val, _b, permB, cresid, os, tol, + // rvec, cholB, disp, maxit); if (cresid.is_empty()) { @@ -3066,14 +3066,14 @@ Array<double> ri (octave_rand::vector(n)); cresid = ComplexColumnVector (n); for (octave_idx_type i = 0; i < n; i++) - cresid(i) = Complex(rr(i),ri(i)); + cresid(i) = Complex(rr(i),ri(i)); octave_rand::distribution(rand_dist); } if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -3082,24 +3082,24 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } @@ -3107,26 +3107,26 @@ { // Check that we really have a permutation vector if (permB.length() != n) - { - (*current_liboctave_error_handler) ("eigs: permB vector invalid"); - return -1; - } + { + (*current_liboctave_error_handler) ("eigs: permB vector invalid"); + return -1; + } else - { - Array<bool> checked(n,false); - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type bidx = - static_cast<octave_idx_type> (permB(i)); - if (checked(bidx) || bidx < 0 || - bidx >= n || D_NINT (bidx) != bidx) - { - (*current_liboctave_error_handler) - ("eigs: permB vector invalid"); - return -1; - } - } - } + { + Array<bool> checked(n,false); + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type bidx = + static_cast<octave_idx_type> (permB(i)); + if (checked(bidx) || bidx < 0 || + bidx >= n || D_NINT (bidx) != bidx) + { + (*current_liboctave_error_handler) + ("eigs: permB vector invalid"); + return -1; + } + } + } } char bmat = 'I'; @@ -3163,7 +3163,7 @@ return -1; octave_idx_type lwork = p * (3 * p + 5); - + OCTAVE_LOCAL_BUFFER (Complex, v, n * p); OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); @@ -3173,111 +3173,111 @@ do { F77_FUNC (znaupd, ZNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, rwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, rwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in znaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in znaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - if (have_b) - { - if (ido == -1) - { - OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); - - vector_product (m, workd+iptr(0)-1, ctmp); - - ComplexMatrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ctmp[P[i]]; - - lusolve (L, U, tmp); - - Complex *ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - else if (ido == 2) - vector_product (b, workd + iptr(0) - 1, workd + iptr(1) - 1); - else - { - Complex *ip2 = workd+iptr(2)-1; - ComplexMatrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - else - { - if (ido == 2) - { - for (octave_idx_type i = 0; i < n; i++) - workd[iptr(0) + i - 1] = - workd[iptr(1) + i - 1]; - } - else - { - Complex *ip2 = workd+iptr(0)-1; - ComplexMatrix tmp(n, 1); - - for (octave_idx_type i = 0; i < n; i++) - tmp(i,0) = ip2[P[i]]; - - lusolve (L, U, tmp); - - ip2 = workd+iptr(1)-1; - for (octave_idx_type i = 0; i < n; i++) - ip2[Q[i]] = tmp(i,0); - } - } - } + { + if (have_b) + { + if (ido == -1) + { + OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); + + vector_product (m, workd+iptr(0)-1, ctmp); + + ComplexMatrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ctmp[P[i]]; + + lusolve (L, U, tmp); + + Complex *ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + else if (ido == 2) + vector_product (b, workd + iptr(0) - 1, workd + iptr(1) - 1); + else + { + Complex *ip2 = workd+iptr(2)-1; + ComplexMatrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + else + { + if (ido == 2) + { + for (octave_idx_type i = 0; i < n; i++) + workd[iptr(0) + i - 1] = + workd[iptr(1) + i - 1]; + } + else + { + Complex *ip2 = workd+iptr(0)-1; + ComplexMatrix tmp(n, 1); + + for (octave_idx_type i = 0; i < n; i++) + tmp(i,0) = ip2[P[i]]; + + lusolve (L, U, tmp); + + ip2 = workd+iptr(1)-1; + for (octave_idx_type i = 0; i < n; i++) + ip2[Q[i]] = tmp(i,0); + } + } + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -3311,7 +3311,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in zneupd"); + ("eigs: unrecoverable exception encountered in zneupd"); return -1; } @@ -3319,40 +3319,40 @@ { octave_idx_type k2 = k / 2; for (octave_idx_type i = 0; i < k2; i++) - { - Complex ctmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = ctmp; - } + { + Complex ctmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = ctmp; + } eig_val.resize(k); if (rvec) - { - OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - ctmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = ctmp[j]; - } - } + { + OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + ctmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = ctmp[j]; + } + } } else { (*current_liboctave_error_handler) - ("eigs: error %d in zneupd", info2); + ("eigs: error %d in zneupd", info2); return -1; } @@ -3361,13 +3361,13 @@ octave_idx_type EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, - const std::string &_typ, Complex sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - ComplexColumnVector &cresid, std::ostream& os, - double tol, int rvec, bool /* cholB */, - int disp, int maxit) + const std::string &_typ, Complex sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + ComplexColumnVector &cresid, std::ostream& os, + double tol, int rvec, bool /* cholB */, + int disp, int maxit) { std::string typ (_typ); bool have_sigma = (std::abs(sigma) ? true : false); @@ -3383,14 +3383,14 @@ Array<double> ri (octave_rand::vector(n)); cresid = ComplexColumnVector (n); for (octave_idx_type i = 0; i < n; i++) - cresid(i) = Complex(rr(i),ri(i)); + cresid(i) = Complex(rr(i),ri(i)); octave_rand::distribution(rand_dist); } if (n < 3) { (*current_liboctave_error_handler) - ("eigs: n must be at least 3"); + ("eigs: n must be at least 3"); return -1; } @@ -3399,48 +3399,48 @@ p = k * 2 + 1; if (p < 20) - p = 20; + p = 20; if (p > n - 1) - p = n - 1 ; + p = n - 1 ; } if (k <= 0 || k >= n - 1) { (*current_liboctave_error_handler) - ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" - " Use 'eig(full(A))' instead"); + ("eigs: Invalid number of eigenvalues to extract (must be 0 < k < n-1).\n" + " Use 'eig(full(A))' instead"); return -1; } if (p <= k || p >= n) { (*current_liboctave_error_handler) - ("eigs: opts.p must be greater than k and less than n"); + ("eigs: opts.p must be greater than k and less than n"); return -1; } if (! have_sigma) { if (typ != "LM" && typ != "SM" && typ != "LA" && typ != "SA" && - typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && - typ != "SI") - (*current_liboctave_error_handler) - ("eigs: unrecognized sigma value"); + typ != "BE" && typ != "LR" && typ != "SR" && typ != "LI" && + typ != "SI") + (*current_liboctave_error_handler) + ("eigs: unrecognized sigma value"); if (typ == "LA" || typ == "SA" || typ == "BE") - { - (*current_liboctave_error_handler) - ("eigs: invalid sigma value for complex problem"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: invalid sigma value for complex problem"); + return -1; + } if (typ == "SM") - { - typ = "LM"; - sigma = 0.; - mode = 3; - } + { + typ = "LM"; + sigma = 0.; + mode = 3; + } } else if (! std::abs (sigma)) typ = "SM"; @@ -3472,7 +3472,7 @@ octave_idx_type ido = 0; int iter = 0; octave_idx_type lwork = p * (3 * p + 5); - + OCTAVE_LOCAL_BUFFER (Complex, v, n * p); OCTAVE_LOCAL_BUFFER (Complex, workl, lwork); OCTAVE_LOCAL_BUFFER (Complex, workd, 3 * n); @@ -3482,66 +3482,66 @@ do { F77_FUNC (znaupd, ZNAUPD) - (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, - F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), - k, tol, presid, p, v, n, iparam, - ipntr, workd, workl, lwork, rwork, info - F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); + (ido, F77_CONST_CHAR_ARG2 (&bmat, 1), n, + F77_CONST_CHAR_ARG2 ((typ.c_str()), 2), + k, tol, presid, p, v, n, iparam, + ipntr, workd, workl, lwork, rwork, info + F77_CHAR_ARG_LEN(1) F77_CHAR_ARG_LEN(2)); if (f77_exception_encountered) - { - (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in znaupd"); - return -1; - } + { + (*current_liboctave_error_handler) + ("eigs: unrecoverable exception encountered in znaupd"); + return -1; + } if (disp > 0 && !xisnan(workl[iptr(5)-1])) - { - if (iter++) - { - os << "Iteration " << iter - 1 << - ": a few Ritz values of the " << p << "-by-" << - p << " matrix\n"; - for (int i = 0 ; i < k; i++) - os << " " << workl[iptr(5)+i-1] << "\n"; - } - - // This is a kludge, as ARPACK doesn't give its - // iteration pointer. But as workl[iptr(5)-1] is - // an output value updated at each iteration, setting - // a value in this array to NaN and testing for it - // is a way of obtaining the iteration counter. - if (ido != 99) - workl[iptr(5)-1] = octave_NaN; - } + { + if (iter++) + { + os << "Iteration " << iter - 1 << + ": a few Ritz values of the " << p << "-by-" << + p << " matrix\n"; + for (int i = 0 ; i < k; i++) + os << " " << workl[iptr(5)+i-1] << "\n"; + } + + // This is a kludge, as ARPACK doesn't give its + // iteration pointer. But as workl[iptr(5)-1] is + // an output value updated at each iteration, setting + // a value in this array to NaN and testing for it + // is a way of obtaining the iteration counter. + if (ido != 99) + workl[iptr(5)-1] = octave_NaN; + } if (ido == -1 || ido == 1 || ido == 2) - { - Complex *ip2 = workd + iptr(0) - 1; - ComplexColumnVector x(n); - - for (octave_idx_type i = 0; i < n; i++) - x(i) = *ip2++; - - ComplexColumnVector y = fun (x, err); - - if (err) - return false; - - ip2 = workd + iptr(1) - 1; - for (octave_idx_type i = 0; i < n; i++) - *ip2++ = y(i); - } + { + Complex *ip2 = workd + iptr(0) - 1; + ComplexColumnVector x(n); + + for (octave_idx_type i = 0; i < n; i++) + x(i) = *ip2++; + + ComplexColumnVector y = fun (x, err); + + if (err) + return false; + + ip2 = workd + iptr(1) - 1; + for (octave_idx_type i = 0; i < n; i++) + *ip2++ = y(i); + } else - { - if (info < 0) - { - (*current_liboctave_error_handler) - ("eigs: error %d in dsaupd", info); - return -1; - } - break; - } + { + if (info < 0) + { + (*current_liboctave_error_handler) + ("eigs: error %d in dsaupd", info); + return -1; + } + break; + } } while (1); @@ -3575,7 +3575,7 @@ if (f77_exception_encountered) { (*current_liboctave_error_handler) - ("eigs: unrecoverable exception encountered in zneupd"); + ("eigs: unrecoverable exception encountered in zneupd"); return -1; } @@ -3583,40 +3583,40 @@ { octave_idx_type k2 = k / 2; for (octave_idx_type i = 0; i < k2; i++) - { - Complex ctmp = d[i]; - d[i] = d[k - i - 1]; - d[k - i - 1] = ctmp; - } + { + Complex ctmp = d[i]; + d[i] = d[k - i - 1]; + d[k - i - 1] = ctmp; + } eig_val.resize(k); if (rvec) - { - OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); - - for (octave_idx_type i = 0; i < k2; i++) - { - octave_idx_type off1 = i * n; - octave_idx_type off2 = (k - i - 1) * n; - - if (off1 == off2) - continue; - - for (octave_idx_type j = 0; j < n; j++) - ctmp[j] = z[off1 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off1 + j] = z[off2 + j]; - - for (octave_idx_type j = 0; j < n; j++) - z[off2 + j] = ctmp[j]; - } - } + { + OCTAVE_LOCAL_BUFFER (Complex, ctmp, n); + + for (octave_idx_type i = 0; i < k2; i++) + { + octave_idx_type off1 = i * n; + octave_idx_type off2 = (k - i - 1) * n; + + if (off1 == off2) + continue; + + for (octave_idx_type j = 0; j < n; j++) + ctmp[j] = z[off1 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off1 + j] = z[off2 + j]; + + for (octave_idx_type j = 0; j < n; j++) + z[off2 + j] = ctmp[j]; + } + } } else { (*current_liboctave_error_handler) - ("eigs: error %d in zneupd", info2); + ("eigs: error %d in zneupd", info2); return -1; } @@ -3626,168 +3626,168 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) extern octave_idx_type EigsRealSymmetricMatrix (const Matrix& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const Matrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const Matrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealSymmetricMatrix (const SparseMatrix& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const SparseMatrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream& os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const SparseMatrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream& os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealSymmetricMatrixShift (const Matrix& m, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const Matrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const Matrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealSymmetricMatrixShift (const SparseMatrix& m, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, Matrix &eig_vec, - ColumnVector &eig_val, const SparseMatrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, Matrix &eig_vec, + ColumnVector &eig_val, const SparseMatrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealSymmetricFunc (EigsFunc fun, octave_idx_type n, - const std::string &typ, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - Matrix &eig_vec, ColumnVector &eig_val, - ColumnVector &resid, std::ostream &os, - double tol = DBL_EPSILON, int rvec = 0, - bool cholB = 0, int disp = 0, int maxit = 300); + const std::string &typ, double sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + Matrix &eig_vec, ColumnVector &eig_val, + ColumnVector &resid, std::ostream &os, + double tol = DBL_EPSILON, int rvec = 0, + bool cholB = 0, int disp = 0, int maxit = 300); extern octave_idx_type EigsRealNonSymmetricMatrix (const Matrix& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const Matrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const Matrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealNonSymmetricMatrix (const SparseMatrix& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const SparseMatrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const SparseMatrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealNonSymmetricMatrixShift (const Matrix& m, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, const Matrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, const Matrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealNonSymmetricMatrixShift (const SparseMatrix& m, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const SparseMatrix& b, - ColumnVector &permB, ColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const SparseMatrix& b, + ColumnVector &permB, ColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsRealNonSymmetricFunc (EigsFunc fun, octave_idx_type n, - const std::string &_typ, double sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - ColumnVector &resid, std::ostream& os, - double tol = DBL_EPSILON, int rvec = 0, - bool cholB = 0, int disp = 0, int maxit = 300); + const std::string &_typ, double sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + ColumnVector &resid, std::ostream& os, + double tol = DBL_EPSILON, int rvec = 0, + bool cholB = 0, int disp = 0, int maxit = 300); extern octave_idx_type EigsComplexNonSymmetricMatrix (const ComplexMatrix& m, const std::string typ, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const ComplexMatrix& b, ColumnVector &permB, - ComplexColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const ComplexMatrix& b, ColumnVector &permB, + ComplexColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsComplexNonSymmetricMatrix (const SparseComplexMatrix& m, - const std::string typ, octave_idx_type k, - octave_idx_type p, octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const SparseComplexMatrix& b, - ColumnVector &permB, - ComplexColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, int disp = 0, - int maxit = 300); + const std::string typ, octave_idx_type k, + octave_idx_type p, octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const SparseComplexMatrix& b, + ColumnVector &permB, + ComplexColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, int disp = 0, + int maxit = 300); extern octave_idx_type EigsComplexNonSymmetricMatrixShift (const ComplexMatrix& m, Complex sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const ComplexMatrix& b, - ColumnVector &permB, - ComplexColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, - int disp = 0, int maxit = 300); + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const ComplexMatrix& b, + ColumnVector &permB, + ComplexColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, + int disp = 0, int maxit = 300); extern octave_idx_type EigsComplexNonSymmetricMatrixShift (const SparseComplexMatrix& m, - Complex sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, - ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - const SparseComplexMatrix& b, - ColumnVector &permB, - ComplexColumnVector &resid, - std::ostream &os, double tol = DBL_EPSILON, - int rvec = 0, bool cholB = 0, - int disp = 0, int maxit = 300); + Complex sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, + ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + const SparseComplexMatrix& b, + ColumnVector &permB, + ComplexColumnVector &resid, + std::ostream &os, double tol = DBL_EPSILON, + int rvec = 0, bool cholB = 0, + int disp = 0, int maxit = 300); extern octave_idx_type EigsComplexNonSymmetricFunc (EigsComplexFunc fun, octave_idx_type n, - const std::string &_typ, Complex sigma, - octave_idx_type k, octave_idx_type p, - octave_idx_type &info, ComplexMatrix &eig_vec, - ComplexColumnVector &eig_val, - ComplexColumnVector &resid, std::ostream& os, - double tol = DBL_EPSILON, int rvec = 0, - bool cholB = 0, int disp = 0, int maxit = 300); + const std::string &_typ, Complex sigma, + octave_idx_type k, octave_idx_type p, + octave_idx_type &info, ComplexMatrix &eig_vec, + ComplexColumnVector &eig_val, + ComplexColumnVector &resid, std::ostream& os, + double tol = DBL_EPSILON, int rvec = 0, + bool cholB = 0, int disp = 0, int maxit = 300); #endif #ifndef _MSC_VER @@ -3796,7 +3796,7 @@ template static octave_idx_type lusolve (const SparseComplexMatrix&, const SparseComplexMatrix&, - ComplexMatrix&); + ComplexMatrix&); template static octave_idx_type lusolve (const Matrix&, const Matrix&, Matrix&); @@ -3806,7 +3806,7 @@ template static ComplexMatrix ltsolve (const SparseComplexMatrix&, const ColumnVector&, - const ComplexMatrix&); + const ComplexMatrix&); template static Matrix ltsolve (const SparseMatrix&, const ColumnVector&, const Matrix&); @@ -3819,7 +3819,7 @@ template static ComplexMatrix utsolve (const SparseComplexMatrix&, const ColumnVector&, - const ComplexMatrix&); + const ComplexMatrix&); template static Matrix utsolve (const SparseMatrix&, const ColumnVector&, const Matrix&);
--- a/liboctave/fCColVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCColVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,10 +42,10 @@ { F77_RET_T F77_FUNC (cgemv, CGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const FloatComplex&, - const FloatComplex*, const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, const FloatComplex&, FloatComplex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const FloatComplex&, + const FloatComplex*, const octave_idx_type&, const FloatComplex*, + const octave_idx_type&, const FloatComplex&, FloatComplex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); } // FloatComplex 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/fCDiagMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCDiagMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -250,7 +250,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = FloatComplexDiagMatrix (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) == static_cast<float> (0.0)) - { - info = -1; - return *this; - } + { + info = -1; + return *this; + } else - retval.elem (i, i) = static_cast<float> (1.0) / elem (i, i); + retval.elem (i, i) = static_cast<float> (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/fCMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -65,35 +65,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 (cgebal, CGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, FloatComplex*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgebak, SGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, float*, 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&, float*, + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgemm, CGEMM) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const FloatComplex&, const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, const FloatComplex&, - FloatComplex*, 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 FloatComplex&, const FloatComplex*, const octave_idx_type&, + const FloatComplex*, const octave_idx_type&, const FloatComplex&, + FloatComplex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgemv, CGEMV) (F77_CONST_CHAR_ARG_DECL, @@ -104,127 +104,127 @@ F77_RET_T F77_FUNC (xcdotu, XCDOTU) (const octave_idx_type&, const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, FloatComplex&); + const FloatComplex*, const octave_idx_type&, FloatComplex&); F77_RET_T F77_FUNC (xcdotc, XCDOTC) (const octave_idx_type&, const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, FloatComplex&); + const FloatComplex*, const octave_idx_type&, FloatComplex&); F77_RET_T F77_FUNC (csyrk, CSYRK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const FloatComplex&, const FloatComplex*, const octave_idx_type&, - const FloatComplex&, FloatComplex*, 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 FloatComplex&, const FloatComplex*, const octave_idx_type&, + const FloatComplex&, FloatComplex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cherk, CHERK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const float&, const FloatComplex*, const octave_idx_type&, - const float&, FloatComplex*, 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 float&, const FloatComplex*, const octave_idx_type&, + const float&, FloatComplex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgetrf, CGETRF) (const octave_idx_type&, const octave_idx_type&, FloatComplex*, const octave_idx_type&, - octave_idx_type*, octave_idx_type&); + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (cgetrs, CGETRS) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, FloatComplex*, const octave_idx_type&, - const octave_idx_type*, FloatComplex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, FloatComplex*, const octave_idx_type&, + const octave_idx_type*, FloatComplex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgetri, CGETRI) (const octave_idx_type&, FloatComplex*, const octave_idx_type&, const octave_idx_type*, - FloatComplex*, const octave_idx_type&, octave_idx_type&); + FloatComplex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cgecon, CGECON) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, - const octave_idx_type&, const float&, float&, - FloatComplex*, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, FloatComplex*, + const octave_idx_type&, const float&, float&, + FloatComplex*, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgelsy, CGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, - const octave_idx_type&, octave_idx_type*, float&, octave_idx_type&, - FloatComplex*, const octave_idx_type&, float*, octave_idx_type&); + FloatComplex*, const octave_idx_type&, FloatComplex*, + const octave_idx_type&, octave_idx_type*, float&, octave_idx_type&, + FloatComplex*, const octave_idx_type&, float*, octave_idx_type&); F77_RET_T F77_FUNC (cgelsd, CGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, - const octave_idx_type&, float*, float&, octave_idx_type&, - FloatComplex*, const octave_idx_type&, float*, - octave_idx_type*, octave_idx_type&); + FloatComplex*, const octave_idx_type&, FloatComplex*, + const octave_idx_type&, float*, float&, octave_idx_type&, + FloatComplex*, const octave_idx_type&, float*, + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (cpotrf, CPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cpocon, CPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, const float&, - float&, FloatComplex*, float*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, const float&, + float&, FloatComplex*, float*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cpotrs, CPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, FloatComplex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const FloatComplex*, + const octave_idx_type&, FloatComplex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ctrtri, CTRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const FloatComplex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ctrcon, CTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, float&, - FloatComplex*, float*, 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 FloatComplex*, const octave_idx_type&, float&, + FloatComplex*, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ctrtrs, CTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, FloatComplex*, - 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 FloatComplex*, + const octave_idx_type&, FloatComplex*, + 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 (clartg, CLARTG) (const FloatComplex&, const FloatComplex&, - float&, FloatComplex&, FloatComplex&); + float&, FloatComplex&, FloatComplex&); F77_RET_T F77_FUNC (ctrsyl, CTRSYL) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, float&, 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 FloatComplex*, const octave_idx_type&, + const FloatComplex*, const octave_idx_type&, + const FloatComplex*, const octave_idx_type&, float&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xclange, XCLANGE) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, float*, float& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const FloatComplex*, + const octave_idx_type&, float*, float& + F77_CHAR_ARG_LEN_DECL); } static const FloatComplex FloatComplex_NaN_result (octave_Float_NaN, octave_Float_NaN); @@ -331,9 +331,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; } @@ -360,8 +360,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; @@ -383,7 +383,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; @@ -405,7 +405,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; @@ -432,7 +432,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; @@ -477,7 +477,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; @@ -504,7 +504,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; @@ -521,8 +521,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; @@ -539,8 +539,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; @@ -567,8 +567,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; @@ -595,8 +595,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; @@ -754,7 +754,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -773,7 +773,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -792,7 +792,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -811,7 +811,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -830,7 +830,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -849,7 +849,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -868,7 +868,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -887,7 +887,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return *this; } @@ -970,7 +970,7 @@ FloatComplexMatrix FloatComplexMatrix::inverse (octave_idx_type& info, float& rcon, int force, - int calc_cond) const + int calc_cond) const { MatrixType mattype (*this); return inverse (mattype, info, rcon, force, calc_cond); @@ -993,7 +993,7 @@ FloatComplexMatrix FloatComplexMatrix::tinverse (MatrixType &mattype, octave_idx_type& info, - float& rcon, int force, int calc_cond) const + float& rcon, int force, int calc_cond) const { FloatComplexMatrix retval; @@ -1011,38 +1011,38 @@ FloatComplex *tmp_data = retval.fortran_vec (); F77_XFCN (ctrtri, CTRTRI, (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 (FloatComplex, cwork, 2*nr); - OCTAVE_LOCAL_BUFFER (float, rwork, nr); - - F77_XFCN (ctrcon, CTRCON, (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 (FloatComplex, cwork, 2*nr); + OCTAVE_LOCAL_BUFFER (float, rwork, nr); + + F77_XFCN (ctrcon, CTRCON, (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; @@ -1050,7 +1050,7 @@ FloatComplexMatrix FloatComplexMatrix::finverse (MatrixType &mattype, octave_idx_type& info, - float& rcon, int force, int calc_cond) const + float& rcon, int force, int calc_cond) const { FloatComplexMatrix retval; @@ -1073,7 +1073,7 @@ // Query the optimum work array size. F77_XFCN (cgetri, CGETRI, (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); @@ -1085,45 +1085,45 @@ // Calculate the norm of the matrix, for later use. float 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 (cgetrf, CGETRF, (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<float> rz (2 * nc); - float *prz = rz.fortran_vec (); - F77_XFCN (cgecon, CGECON, (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<float> rz (2 * nc); + float *prz = rz.fortran_vec (); + F77_XFCN (cgecon, CGECON, (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 (cgetri, CGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, zgetri_info)); - - if (zgetri_info != 0) - info = -1; - } + { + octave_idx_type zgetri_info = 0; + + F77_XFCN (cgetri, CGETRI, (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; @@ -1131,7 +1131,7 @@ FloatComplexMatrix FloatComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info, - float& rcon, int force, int calc_cond) const + float& rcon, int force, int calc_cond) const { int typ = mattype.type (false); FloatComplexMatrix ret; @@ -1144,25 +1144,25 @@ else { if (mattype.is_hermitian ()) - { - FloatComplexCHOL 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 (); - } + { + FloatComplexCHOL 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 = FloatComplexMatrix (rows (), columns (), FloatComplex (octave_Float_Inf, 0.)); + ret = FloatComplexMatrix (rows (), columns (), FloatComplex (octave_Float_Inf, 0.)); } return ret; @@ -1188,9 +1188,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) @@ -1451,12 +1451,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 (cfftf, CFFTF) (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; @@ -1520,12 +1520,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 (cfftb, CFFTB) (npts, prow, pwsave); for (octave_idx_type i = 0; i < npts; i++) - tmp_data[i*nr + j] = prow[i] / static_cast<float> (npts); + tmp_data[i*nr + j] = prow[i] / static_cast<float> (npts); } return retval; @@ -1712,145 +1712,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 FloatComplex *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (ctrcon, CTRCON, (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 FloatComplex *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (ctrcon, CTRCON, (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 FloatComplex *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (ctrcon, CTRCON, (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 FloatComplex *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (ctrcon, CTRCON, (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) - { - float anorm = -1.0; - FloatComplexMatrix atmp = *this; - FloatComplex *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 (cpotrf, CPOTRF, (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<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (cpocon, CPOCON, (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<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (2 * nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (cgetrf, CGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (info != 0) - { - rcon = 0.0; - mattype.mark_as_rectangular (); - } - else - { - char job = '1'; - F77_XFCN (cgecon, CGECON, (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; - } - } - } + { + float anorm = -1.0; + FloatComplexMatrix atmp = *this; + FloatComplex *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 (cpotrf, CPOTRF, (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<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (cpocon, CPOCON, (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<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (2 * nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (cgetrf, CGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (info != 0) + { + rcon = 0.0; + mattype.mark_as_rectangular (); + } + else + { + char job = '1'; + F77_XFCN (cgecon, CGECON, (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; @@ -1858,9 +1858,9 @@ FloatComplexMatrix FloatComplexMatrix::utsolve (MatrixType &mattype, const FloatComplexMatrix& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { FloatComplexMatrix retval; @@ -1877,81 +1877,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 FloatComplex *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (ctrcon, CTRCON, (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 float 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; - FloatComplex *result = retval.fortran_vec (); - - char uplo = 'U'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (ctrtrs, CTRTRS, (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 FloatComplex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (ctrcon, CTRCON, (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 float 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; + FloatComplex *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (ctrtrs, CTRTRS, (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; @@ -1959,9 +1959,9 @@ FloatComplexMatrix FloatComplexMatrix::ltsolve (MatrixType &mattype, const FloatComplexMatrix& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { FloatComplexMatrix retval; @@ -1978,81 +1978,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 FloatComplex *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (ctrcon, CTRCON, (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 float 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; - FloatComplex *result = retval.fortran_vec (); - - char uplo = 'L'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (ctrtrs, CTRTRS, (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 FloatComplex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (ctrcon, CTRCON, (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 float 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; + FloatComplex *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (ctrtrs, CTRTRS, (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; @@ -2060,9 +2060,9 @@ FloatComplexMatrix FloatComplexMatrix::fsolve (MatrixType &mattype, const FloatComplexMatrix& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, - bool calc_cond) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, + bool calc_cond) const { FloatComplexMatrix retval; @@ -2083,160 +2083,160 @@ float anorm = -1.; if (typ == MatrixType::Hermitian) - { - info = 0; - char job = 'L'; - FloatComplexMatrix atmp = *this; - FloatComplex *tmp_data = atmp.fortran_vec (); - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (cpotrf, CPOTRF, (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<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (nc); - float *prz = rz.fortran_vec (); - - F77_XFCN (cpocon, CPOCON, (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 float 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; - FloatComplex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (cpotrs, CPOTRS, (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'; + FloatComplexMatrix atmp = *this; + FloatComplex *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (cpotrf, CPOTRF, (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<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (nc); + float *prz = rz.fortran_vec (); + + F77_XFCN (cpocon, CPOCON, (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 float 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; + FloatComplex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (cpotrs, CPOTRS, (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 (); - - FloatComplexMatrix atmp = *this; - FloatComplex *tmp_data = atmp.fortran_vec (); - - Array<FloatComplex> z (2 * nc); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (2 * nc); - float *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 (cgetrf, CGETRF, (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 (cgecon, CGECON, (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 float 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; - FloatComplex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - char job = 'N'; - F77_XFCN (cgetrs, CGETRS, (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 (); + + FloatComplexMatrix atmp = *this; + FloatComplex *tmp_data = atmp.fortran_vec (); + + Array<FloatComplex> z (2 * nc); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (2 * nc); + float *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 (cgetrf, CGETRF, (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 (cgecon, CGECON, (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 float 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; + FloatComplex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (cgetrs, CGETRS, (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; @@ -2252,7 +2252,7 @@ FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &typ, const FloatMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { float rcon; return solve (typ, b, info, rcon, 0); @@ -2260,15 +2260,15 @@ FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &typ, const FloatMatrix& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (typ, b, info, rcon, 0); } FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &typ, const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { FloatComplexMatrix tmp (b); return solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt); @@ -2284,7 +2284,7 @@ FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, - octave_idx_type& info) const + octave_idx_type& info) const { float rcon; return solve (typ, b, info, rcon, 0); @@ -2292,16 +2292,16 @@ FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, - octave_idx_type& info, float& rcon) const + octave_idx_type& info, float& rcon) const { return solve (typ, b, info, rcon, 0); } FloatComplexMatrix FloatComplexMatrix::solve (MatrixType &mattype, const FloatComplexMatrix& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { FloatComplexMatrix retval; int typ = mattype.type (); @@ -2346,7 +2346,7 @@ FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { float rcon; return solve (typ, FloatComplexColumnVector (b), info, rcon, 0); @@ -2354,15 +2354,15 @@ FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatColumnVector& b, - octave_idx_type& info, float& rcon) const + octave_idx_type& info, float& rcon) const { return solve (typ, FloatComplexColumnVector (b), info, rcon, 0); } FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatColumnVector& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { return solve (typ, FloatComplexColumnVector (b), info, rcon, sing_handler, transt); } @@ -2377,7 +2377,7 @@ FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { float rcon; return solve (typ, b, info, rcon, 0); @@ -2385,15 +2385,15 @@ FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info, float& rcon) const + octave_idx_type& info, float& rcon) const { return solve (typ, b, info, rcon, 0); } FloatComplexColumnVector FloatComplexMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatComplexMatrix tmp (b); @@ -2423,7 +2423,7 @@ FloatComplexMatrix FloatComplexMatrix::solve (const FloatMatrix& b, octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatComplexMatrix tmp (b); return solve (tmp, info, rcon, sing_handler, transt); @@ -2452,7 +2452,7 @@ FloatComplexMatrix FloatComplexMatrix::solve (const FloatComplexMatrix& b, octave_idx_type& info, float& 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); @@ -2475,15 +2475,15 @@ FloatComplexColumnVector FloatComplexMatrix::solve (const FloatColumnVector& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (FloatComplexColumnVector (b), info, rcon, 0); } FloatComplexColumnVector FloatComplexMatrix::solve (const FloatColumnVector& b, octave_idx_type& info, - float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + float& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { return solve (FloatComplexColumnVector (b), info, rcon, sing_handler, transt); } @@ -2505,15 +2505,15 @@ FloatComplexColumnVector FloatComplexMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (b, info, rcon, 0); } FloatComplexColumnVector FloatComplexMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info, - float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + float& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { MatrixType mattype (*this); return solve (mattype, b, info, rcon, sing_handler, transt); @@ -2538,7 +2538,7 @@ FloatComplexMatrix FloatComplexMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (FloatComplexMatrix (b), info, rank, rcon); @@ -2546,7 +2546,7 @@ FloatComplexMatrix FloatComplexMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, - octave_idx_type& rank, float& rcon) const + octave_idx_type& rank, float& rcon) const { return lssolve (FloatComplexMatrix (b), info, rank, rcon); } @@ -2570,7 +2570,7 @@ FloatComplexMatrix FloatComplexMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (b, info, rank, rcon); @@ -2578,7 +2578,7 @@ FloatComplexMatrix FloatComplexMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank, float& rcon) const + octave_idx_type& rank, float& rcon) const { FloatComplexMatrix retval; @@ -2599,15 +2599,15 @@ rcon = -1.0; if (m != n) - { - retval = FloatComplexMatrix (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 = FloatComplexMatrix (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; FloatComplexMatrix atmp = *this; FloatComplex *tmp_data = atmp.fortran_vec (); @@ -2623,17 +2623,17 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("CGELSD", 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 ("CGELSD", 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 @@ -2647,72 +2647,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<float> rwork (lrwork); float *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 (cgelsd, CGELSD, (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 (cgelsd, CGELSD, (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); } @@ -2739,7 +2739,7 @@ FloatComplexColumnVector FloatComplexMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (FloatComplexColumnVector (b), info, rank, rcon); @@ -2747,7 +2747,7 @@ FloatComplexColumnVector FloatComplexMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, float& rcon) const + octave_idx_type& rank, float& rcon) const { return lssolve (FloatComplexColumnVector (b), info, rank, rcon); } @@ -2771,7 +2771,7 @@ FloatComplexColumnVector FloatComplexMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (b, info, rank, rcon); @@ -2780,7 +2780,7 @@ FloatComplexColumnVector FloatComplexMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, float& rcon) const + octave_idx_type& rank, float& rcon) const { FloatComplexColumnVector retval; @@ -2801,14 +2801,14 @@ rcon = -1.0; if (m != n) - { - retval = FloatComplexColumnVector (maxmn); - - for (octave_idx_type i = 0; i < m; i++) - retval.elem (i) = b.elem (i); - } + { + retval = FloatComplexColumnVector (maxmn); + + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i) = b.elem (i); + } else - retval = b; + retval = b; FloatComplexMatrix atmp = *this; FloatComplex *tmp_data = atmp.fortran_vec (); @@ -2824,10 +2824,10 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("CGELSD", 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 @@ -2841,24 +2841,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<float> rwork (lrwork); float *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 (cgelsd, CGELSD, (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); @@ -2866,24 +2866,24 @@ iwork.resize (iwork(0)); F77_XFCN (cgelsd, CGELSD, (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; @@ -2920,11 +2920,11 @@ FloatComplex *c = retval.fortran_vec (); F77_XFCN (cgemm, CGEMM, (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; @@ -3085,9 +3085,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - FloatComplex val = elem (i, j); - if (xisnan (val)) - return true; + FloatComplex val = elem (i, j); + if (xisnan (val)) + return true; } return false; @@ -3102,9 +3102,9 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - FloatComplex val = elem (i, j); - if (xisinf (val) || xisnan (val)) - return true; + FloatComplex val = elem (i, j); + if (xisinf (val) || xisnan (val)) + return true; } return false; @@ -3139,10 +3139,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; @@ -3150,25 +3150,25 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - FloatComplex val = elem (i, j); - - float r_val = std::real (val); - float 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; + FloatComplex val = elem (i, j); + + float r_val = std::real (val); + float 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; @@ -3183,16 +3183,16 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - FloatComplex val = elem (i, j); - - float r_val = std::real (val); - float 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; + FloatComplex val = elem (i, j); + + float r_val = std::real (val); + float 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; @@ -3265,13 +3265,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 @@ -3284,13 +3284,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; } FloatComplexColumnVector @@ -3315,52 +3315,52 @@ for (octave_idx_type i = 0; i < nr; i++) { - bool real_only = row_is_real_only (i); - - octave_idx_type idx_j; - - FloatComplex tmp_min; - - float abs_min = octave_Float_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++) - { - FloatComplex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - float 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) = FloatComplex_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; + + FloatComplex tmp_min; + + float abs_min = octave_Float_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++) + { + FloatComplex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + float 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) = FloatComplex_NaN_result; + idx_arg.elem (i) = 0; + } + else + { + result.elem (i) = tmp_min; + idx_arg.elem (i) = idx_j; + } } } @@ -3389,52 +3389,52 @@ for (octave_idx_type i = 0; i < nr; i++) { - bool real_only = row_is_real_only (i); - - octave_idx_type idx_j; - - FloatComplex tmp_max; - - float abs_max = octave_Float_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++) - { - FloatComplex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - float 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) = FloatComplex_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; + + FloatComplex tmp_max; + + float abs_max = octave_Float_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++) + { + FloatComplex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + float 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) = FloatComplex_NaN_result; + idx_arg.elem (i) = 0; + } + else + { + result.elem (i) = tmp_max; + idx_arg.elem (i) = idx_j; + } } } @@ -3463,52 +3463,52 @@ for (octave_idx_type j = 0; j < nc; j++) { - bool real_only = column_is_real_only (j); - - octave_idx_type idx_i; - - FloatComplex tmp_min; - - float abs_min = octave_Float_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++) - { - FloatComplex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - float 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) = FloatComplex_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; + + FloatComplex tmp_min; + + float abs_min = octave_Float_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++) + { + FloatComplex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + float 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) = FloatComplex_NaN_result; + idx_arg.elem (j) = 0; + } + else + { + result.elem (j) = tmp_min; + idx_arg.elem (j) = idx_i; + } } } @@ -3537,52 +3537,52 @@ for (octave_idx_type j = 0; j < nc; j++) { - bool real_only = column_is_real_only (j); - - octave_idx_type idx_i; - - FloatComplex tmp_max; - - float abs_max = octave_Float_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++) - { - FloatComplex tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - - float 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) = FloatComplex_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; + + FloatComplex tmp_max; + + float abs_max = octave_Float_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++) + { + FloatComplex tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + + float 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) = FloatComplex_NaN_result; + idx_arg.elem (j) = 0; + } + else + { + result.elem (j) = tmp_max; + idx_arg.elem (j) = idx_i; + } } } @@ -3597,10 +3597,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; @@ -3616,14 +3616,14 @@ { FloatComplex tmp; for (octave_idx_type i = 0; i < nr; i++) - for (octave_idx_type j = 0; j < nc; j++) - { - tmp = octave_read_value<FloatComplex> (is); - if (is) - a.elem (i, j) = tmp; - else - goto done; - } + for (octave_idx_type j = 0; j < nc; j++) + { + tmp = octave_read_value<FloatComplex> (is); + if (is) + a.elem (i, j) = tmp; + else + goto done; + } } done: @@ -3651,7 +3651,7 @@ FloatComplexMatrix Sylvester (const FloatComplexMatrix& a, const FloatComplexMatrix& b, - const FloatComplexMatrix& c) + const FloatComplexMatrix& c) { FloatComplexMatrix retval; @@ -3687,11 +3687,11 @@ FloatComplex *px = cx.fortran_vec (); F77_XFCN (ctrsyl, CTRSYL, (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? @@ -3768,13 +3768,13 @@ else { if (a_nr == 0 || a_nc == 0 || b_nc == 0) - retval = FloatComplexMatrix (a_nr, b_nc, 0.0); + retval = FloatComplexMatrix (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 = FloatComplexMatrix (a_nr, b_nc); - FloatComplex *c = retval.fortran_vec (); + FloatComplex *c = retval.fortran_vec (); const char *ctra = get_blas_trans_arg (tra, cja); if (cja || cjb) @@ -3805,15 +3805,15 @@ } else - { - octave_idx_type lda = a.rows (), tda = a.cols (); - octave_idx_type ldb = b.rows (), tdb = b.cols (); - - retval = FloatComplexMatrix (a_nr, b_nc); - FloatComplex *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 = FloatComplexMatrix (a_nr, b_nc); + FloatComplex *c = retval.fortran_vec (); + + if (b_nc == 1 && a_nr == 1) + { if (cja == cjb) { F77_FUNC (xcdotu, XCDOTU) (a_nc, a.data (), 1, b.data (), 1, *c); @@ -3840,18 +3840,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 (cgemm, CGEMM, (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 (cgemm, CGEMM, (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; @@ -3883,8 +3883,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; @@ -3903,8 +3903,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; @@ -3919,7 +3919,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 FloatComplexMatrix (); } @@ -3931,28 +3931,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; @@ -3971,8 +3971,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; @@ -3991,8 +3991,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; @@ -4007,7 +4007,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 FloatComplexMatrix (); } @@ -4019,31 +4019,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/fCNDArray.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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; } @@ -232,17 +232,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 (cfftf, CFFTF) (npts, tmp, pwsave); + F77_FUNC (cfftf, CFFTF) (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; @@ -279,18 +279,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 (cfftb, CFFTB) (npts, tmp, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, tmp, pwsave); - for (octave_idx_type i = 0; i < npts; i++) - retval ((i + k*npts)*stride + j*dist) = tmp[i] / - static_cast<float> (npts); - } + for (octave_idx_type i = 0; i < npts; i++) + retval ((i + k*npts)*stride + j*dist) = tmp[i] / + static_cast<float> (npts); + } } return retval; @@ -316,27 +316,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 (cffti, CFFTI) (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 (cfftf, CFFTF) (npts, prow, pwsave); + F77_FUNC (cfftf, CFFTF) (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); } @@ -364,28 +364,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 (cffti, CFFTI) (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 (cfftb, CFFTB) (npts, prow, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<float> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<float> (npts); + } + } stride *= dv2(i); } @@ -412,27 +412,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 (cffti, CFFTI) (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 (cfftf, CFFTF) (npts, prow, pwsave); + F77_FUNC (cfftf, CFFTF) (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); } @@ -459,28 +459,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 (cffti, CFFTI) (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 (cfftb, CFFTB) (npts, prow, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<float> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<float> (npts); + } + } stride *= dv(i); } @@ -509,7 +509,7 @@ { FloatComplex val = elem (i); if (xisnan (val)) - return true; + return true; } return false; } @@ -523,7 +523,7 @@ { FloatComplex val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; } @@ -556,10 +556,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; @@ -572,19 +572,19 @@ float 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; @@ -603,10 +603,10 @@ float 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; @@ -787,14 +787,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; @@ -804,16 +804,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) @@ -852,15 +852,15 @@ void FloatComplexNDArray::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 FloatComplexNDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); } @@ -895,13 +895,13 @@ { FloatComplex tmp; for (octave_idx_type i = 0; i < nel; i++) - { - tmp = octave_read_value<FloatComplex> (is); - if (is) - a.elem (i) = tmp; - else - goto done; - } + { + tmp = octave_read_value<FloatComplex> (is); + if (is) + a.elem (i) = tmp; + else + goto done; + } } done:
--- a/liboctave/fCRowVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCRowVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,14 +42,14 @@ { F77_RET_T F77_FUNC (cgemv, CGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const FloatComplex&, - const FloatComplex*, const octave_idx_type&, const FloatComplex*, - const octave_idx_type&, const FloatComplex&, FloatComplex*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const FloatComplex&, + const FloatComplex*, const octave_idx_type&, const FloatComplex*, + const octave_idx_type&, const FloatComplex&, FloatComplex*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xcdotu, XCDOTU) (const octave_idx_type&, const FloatComplex*, const octave_idx_type&, - const FloatComplex*, const octave_idx_type&, FloatComplex&); + const FloatComplex*, const octave_idx_type&, FloatComplex&); } // FloatComplex 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); - FloatComplex *y = retval.fortran_vec (); + retval.resize (a_nc); + FloatComplex *y = retval.fortran_vec (); - F77_XFCN (cgemv, CGEMV, (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 (cgemv, CGEMV, (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/fCmplxAEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxAEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -36,17 +36,17 @@ { F77_RET_T F77_FUNC (cgebal, CGEBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - octave_idx_type&, octave_idx_type&, float*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, + octave_idx_type&, octave_idx_type&, float*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgebak, CGEBAK) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, const float*, - const octave_idx_type&, FloatComplex*, - 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 float*, + const octave_idx_type&, FloatComplex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); } FloatComplexAEPBALANCE::FloatComplexAEPBALANCE (const FloatComplexMatrix& a, @@ -72,9 +72,9 @@ job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B'); F77_XFCN (cgebal, CGEBAL, (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))); } FloatComplexMatrix @@ -93,11 +93,11 @@ char side = 'R'; F77_XFCN (cgebak, CGEBAK, (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/fCmplxCHOL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -43,18 +43,18 @@ { F77_RET_T F77_FUNC (cpotrf, CPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cpotri, CPOTRI) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cpocon, CPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, const float&, - float&, FloatComplex*, float*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + FloatComplex*, const octave_idx_type&, const float&, + float&, FloatComplex*, float*, + 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) - ("FloatComplexCHOL requires square matrix"); + ("FloatComplexCHOL requires square matrix"); return -1; } @@ -113,7 +113,7 @@ anorm = xnorm (a, 1); F77_XFCN (cpotrf, CPOTRF, (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<float> rz (n); float *prz = rz.fortran_vec (); F77_XFCN (cpocon, CPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, prz, cpocon_info - F77_CHAR_ARG_LEN (1))); + n, anorm, xrcond, pz, prz, cpocon_info + F77_CHAR_ARG_LEN (1))); if (cpocon_info != 0) - info = -1; + info = -1; } return info; @@ -154,16 +154,16 @@ FloatComplexMatrix tmp = r; F77_XFCN (cpotri, CPOTRI, (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/fCmplxGEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxGEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -37,27 +37,27 @@ { F77_RET_T F77_FUNC (cggbal, CGGBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type& N, - FloatComplex* A, const octave_idx_type& LDA, FloatComplex* B, - const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, - float* LSCALE, float* RSCALE, - float* WORK, octave_idx_type& INFO - F77_CHAR_ARG_LEN_DECL); + FloatComplex* A, const octave_idx_type& LDA, FloatComplex* B, + const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, + float* LSCALE, float* RSCALE, + float* WORK, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sggbak, SGGBAK) (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 float* LSCALE, - const float* RSCALE, octave_idx_type& M, float* 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 float* LSCALE, + const float* RSCALE, octave_idx_type& M, float* V, + const octave_idx_type& LDV, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type FloatComplexGEPBALANCE::init (const FloatComplexMatrix& a, const FloatComplexMatrix& 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 (cggbal, CGGBAL, (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 = FloatMatrix (n, n, 0.0); balancing_mat2 = FloatMatrix (n, n, 0.0); @@ -107,19 +107,19 @@ // first left F77_XFCN (sggbak, SGGBAK, (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 (sggbak, SGGBAK, (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/fCmplxHESS.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxHESS.cc Thu Feb 11 12:23:32 2010 -0500 @@ -33,27 +33,27 @@ { F77_RET_T F77_FUNC (cgebal, CGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, const octave_idx_type&, - octave_idx_type&, octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, FloatComplex*, const octave_idx_type&, + octave_idx_type&, octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgehrd, CGEHRD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, - FloatComplex*, const octave_idx_type&, octave_idx_type&); + FloatComplex*, const octave_idx_type&, FloatComplex*, + FloatComplex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cunghr, CUNGHR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, - FloatComplex*, const octave_idx_type&, octave_idx_type&); + FloatComplex*, const octave_idx_type&, FloatComplex*, + FloatComplex*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cgebak, CGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, FloatComplex*, 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&, float*, + const octave_idx_type&, FloatComplex*, 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) - ("FloatComplexHESS requires square matrix"); + ("FloatComplexHESS requires square matrix"); return -1; } @@ -85,8 +85,8 @@ float *pscale = scale.fortran_vec (); F77_XFCN (cgebal, CGEBAL, (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<FloatComplex> tau (n-1); FloatComplex *ptau = tau.fortran_vec (); @@ -100,13 +100,13 @@ FloatComplex *z = unitary_hess_mat.fortran_vec (); F77_XFCN (cunghr, CUNGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + lwork, info)); F77_XFCN (cgebak, CGEBAK, (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/fCmplxLU.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -45,7 +45,7 @@ { F77_RET_T F77_FUNC (cgetrf, CGETRF) (const octave_idx_type&, const octave_idx_type&, FloatComplex*, - 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/fCmplxQR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,13 +42,13 @@ { F77_RET_T F77_FUNC (cgeqrf, CGEQRF) (const octave_idx_type&, const octave_idx_type&, FloatComplex*, - const octave_idx_type&, FloatComplex*, FloatComplex*, - const octave_idx_type&, octave_idx_type&); + const octave_idx_type&, FloatComplex*, FloatComplex*, + const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cungqr, CUNGQR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, - FloatComplex*, const octave_idx_type&, octave_idx_type&); + FloatComplex*, const octave_idx_type&, FloatComplex*, + FloatComplex*, 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 (FloatComplex, work, lwork); F77_XFCN (cungqr, CUNGQR, (m, k, min_mn, q.fortran_vec (), m, tau, work, lwork, info)); @@ -300,7 +300,7 @@ OCTAVE_LOCAL_BUFFER (float, rw, kmax); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; F77_XFCN (cqrinc, CQRINC, (m, n + ii, std::min (kmax, k + ii), q.fortran_vec (), q.rows (), r.fortran_vec (), r.rows (), js(ii) + 1, @@ -322,7 +322,7 @@ { OCTAVE_LOCAL_BUFFER (float, rw, k); F77_XFCN (cqrdec, CQRDEC, (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) { @@ -359,7 +359,7 @@ OCTAVE_LOCAL_BUFFER (float, 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 (cqrdec, CQRDEC, (m, n - ii, k == m ? k : k - ii, q.fortran_vec (), q.rows (), r.fortran_vec (), r.rows (), js(ii) + 1, rw)); @@ -395,7 +395,7 @@ FloatComplexRowVector utmp = u; OCTAVE_LOCAL_BUFFER (float, rw, k); F77_XFCN (cqrinr, CQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), + r.fortran_vec (), r.rows (), j + 1, utmp.fortran_vec (), rw)); } @@ -416,7 +416,7 @@ OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); OCTAVE_LOCAL_BUFFER (float, rw, m); F77_XFCN (cqrder, CQRDER, (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/fCmplxQRP.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxQRP.cc Thu Feb 11 12:23:32 2010 -0500 @@ -36,8 +36,8 @@ { F77_RET_T F77_FUNC (cgeqp3, CGEQP3) (const octave_idx_type&, const octave_idx_type&, FloatComplex*, - const octave_idx_type&, octave_idx_type*, FloatComplex*, FloatComplex*, - const octave_idx_type&, float*, octave_idx_type&); + const octave_idx_type&, octave_idx_type*, FloatComplex*, FloatComplex*, + const octave_idx_type&, float*, octave_idx_type&); } // It would be best to share some of this code with FloatComplexQR class...
--- a/liboctave/fCmplxSCHUR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxSCHUR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -33,16 +33,16 @@ { F77_RET_T F77_FUNC (cgeesx, CGEESX) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - FloatComplexSCHUR::select_function, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, const octave_idx_type&, octave_idx_type&, - FloatComplex*, FloatComplex*, const octave_idx_type&, float&, - float&, FloatComplex*, const octave_idx_type&, float*, 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, + FloatComplexSCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, FloatComplex*, const octave_idx_type&, octave_idx_type&, + FloatComplex*, FloatComplex*, const octave_idx_type&, float&, + float&, FloatComplex*, const octave_idx_type&, float*, 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 FloatComplexSCHUR::init (const FloatComplexMatrix& 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) - ("FloatComplexSCHUR requires square matrix"); + ("FloatComplexSCHUR requires square matrix"); return -1; } @@ -123,14 +123,14 @@ octave_idx_type *pbwork = bwork.fortran_vec (); F77_XFCN (cgeesx, CGEESX, (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/fCmplxSVD.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fCmplxSVD.cc Thu Feb 11 12:23:32 2010 -0500 @@ -33,13 +33,13 @@ { F77_RET_T F77_FUNC (cgesvd, CGESVD) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, FloatComplex*, - const octave_idx_type&, float*, FloatComplex*, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, - float*, 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&, FloatComplex*, + const octave_idx_type&, float*, FloatComplex*, const octave_idx_type&, + FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, + float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } FloatComplexMatrix @@ -48,7 +48,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("FloatComplexSVD: U not computed because type == SVD::sigma_only"); + ("FloatComplexSVD: U not computed because type == SVD::sigma_only"); return FloatComplexMatrix (); } else @@ -61,7 +61,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("FloatComplexSVD: V not computed because type == SVD::sigma_only"); + ("FloatComplexSVD: V not computed because type == SVD::sigma_only"); return FloatComplexMatrix (); } else @@ -145,23 +145,23 @@ octave_idx_type m1 = std::max (m, one), nrow_vt1 = std::max (nrow_vt, one); F77_XFCN (cgesvd, CGESVD, (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 (cgesvd, CGESVD, (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/fColVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fColVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,11 +42,11 @@ { F77_RET_T F77_FUNC (sgemv, SGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const float&, - const float*, const octave_idx_type&, const float*, - const octave_idx_type&, const float&, float*, - const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const float&, + const float*, const octave_idx_type&, const float*, + const octave_idx_type&, const float&, float*, + const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); } // Column Vector class. @@ -82,7 +82,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; @@ -98,7 +98,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -122,7 +122,7 @@ make_unique (); for (octave_idx_type i = r1; i <= r2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -242,17 +242,17 @@ else { if (nr == 0 || nc == 0) - retval.resize (nr, 0.0); + retval.resize (nr, 0.0); else - { - retval.resize (nr); + { + retval.resize (nr); - for (octave_idx_type i = 0; i < a_len; i++) - retval.elem (i) = a.elem (i) * m.elem (i, i); + for (octave_idx_type i = 0; i < a_len; i++) + retval.elem (i) = a.elem (i) * m.elem (i, i); - for (octave_idx_type i = a_len; i < nr; i++) - retval.elem (i) = 0.0; - } + for (octave_idx_type i = a_len; i < nr; i++) + retval.elem (i) = 0.0; + } } return retval;
--- a/liboctave/fDiagMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fDiagMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -155,7 +155,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = FloatDiagMatrix (mx_inline_real_dup (a.data (), a_len), a.rows (), - a.cols ()); + a.cols ()); return retval; } @@ -166,7 +166,7 @@ octave_idx_type a_len = a.length (); if (a_len > 0) retval = FloatDiagMatrix (mx_inline_imag_dup (a.data (), a_len), a.rows (), - a.cols ()); + a.cols ()); return retval; } @@ -293,12 +293,12 @@ for (octave_idx_type i = 0; i < len; 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; @@ -389,12 +389,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) */ << 0.0; - } + { + if (i == j) + os << " " /* setw (field_width) */ << a.elem (i, i); + else + os << " " /* setw (field_width) */ << 0.0; + } os << "\n"; } return os;
--- a/liboctave/fEIG.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fEIG.cc Thu Feb 11 12:23:32 2010 -0500 @@ -34,99 +34,99 @@ { F77_RET_T F77_FUNC (sgeev, SGEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, float*, - float*, float*, const octave_idx_type&, float*, - const octave_idx_type&, float*, 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&, float*, const octave_idx_type&, float*, + float*, float*, const octave_idx_type&, float*, + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cgeev, CGEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, const octave_idx_type&, FloatComplex*, - FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, FloatComplex*, const octave_idx_type&, FloatComplex*, + FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, + FloatComplex*, const octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ssyev, SSYEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, float*, - float*, 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&, float*, const octave_idx_type&, float*, + float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cheev, CHEEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, FloatComplex*, const octave_idx_type&, float*, - FloatComplex*, const octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, FloatComplex*, const octave_idx_type&, float*, + FloatComplex*, const octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (spotrf, SPOTRF) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - float*, const octave_idx_type&, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, + float*, const octave_idx_type&, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cpotrf, CPOTRF) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, + FloatComplex*, const octave_idx_type&, + octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sggev, SGGEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - float*, const octave_idx_type&, - float*, const octave_idx_type&, - float*, float*, float*, - float*, const octave_idx_type&, float*, const octave_idx_type&, - float*, 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&, + float*, const octave_idx_type&, + float*, const octave_idx_type&, + float*, float*, float*, + float*, const octave_idx_type&, float*, const octave_idx_type&, + float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (ssygv, SSYGV) (const octave_idx_type&, - F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - float*, const octave_idx_type&, - float*, const octave_idx_type&, - float*, float*, 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&, + float*, const octave_idx_type&, + float*, const octave_idx_type&, + float*, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (cggev, CGGEV) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - FloatComplex*, FloatComplex*, - FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, + FloatComplex*, const octave_idx_type&, + FloatComplex*, const octave_idx_type&, + FloatComplex*, FloatComplex*, + FloatComplex*, const octave_idx_type&, FloatComplex*, const octave_idx_type&, + FloatComplex*, const octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (chegv, CHEGV) (const octave_idx_type&, - F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - FloatComplex*, const octave_idx_type&, - float*, FloatComplex*, const octave_idx_type&, float*, - 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&, + FloatComplex*, const octave_idx_type&, + FloatComplex*, const octave_idx_type&, + float*, FloatComplex*, const octave_idx_type&, float*, + 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 (sgeev, SGEEV, (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,56 +185,56 @@ float *pwork = work.fortran_vec (); F77_XFCN (sgeev, SGEEV, (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 sgeev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in sgeev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("sgeev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("sgeev failed to converge"); + return info; + } lambda.resize (n); v.resize (nvr, nvr); for (octave_idx_type j = 0; j < n; j++) - { - if (wi.elem (j) == 0.0) - { - lambda.elem (j) = FloatComplex (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) = FloatComplex (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) = FloatComplex (wr.elem(j), wi.elem(j)); - lambda.elem(j+1) = FloatComplex (wr.elem(j+1), wi.elem(j+1)); + lambda.elem(j) = FloatComplex (wr.elem(j), wi.elem(j)); + lambda.elem(j+1) = FloatComplex (wr.elem(j+1), wi.elem(j+1)); - for (octave_idx_type i = 0; i < nvr; i++) - { - float real_part = vr.elem (i, j); - float imag_part = vr.elem (i, j+1); - v.elem (i, j) = FloatComplex (real_part, imag_part); - v.elem (i, j+1) = FloatComplex (real_part, -imag_part); - } - j++; - } - } + for (octave_idx_type i = 0; i < nvr; i++) + { + float real_part = vr.elem (i, j); + float imag_part = vr.elem (i, j+1); + v.elem (i, j) = FloatComplex (real_part, imag_part); + v.elem (i, j+1) = FloatComplex (real_part, -imag_part); + } + j++; + } + } } else (*current_liboctave_error_handler) ("sgeev workspace query failed"); @@ -265,10 +265,10 @@ float dummy_work; F77_XFCN (ssyev, SSYEV, (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) { @@ -277,22 +277,22 @@ float *pwork = work.fortran_vec (); F77_XFCN (ssyev, SSYEV, (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 ssyev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in ssyev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("ssyev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("ssyev failed to converge"); + return info; + } lambda = FloatComplexColumnVector (wr); v = calc_ev ? FloatComplexMatrix (atmp) : FloatComplexMatrix (); @@ -309,7 +309,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; } @@ -347,11 +347,11 @@ octave_idx_type idummy = 1; F77_XFCN (cgeev, CGEEV, (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) { @@ -360,23 +360,23 @@ FloatComplex *pwork = work.fortran_vec (); F77_XFCN (cgeev, CGEEV, (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 cgeev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in cgeev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("cgeev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("cgeev failed to converge"); + return info; + } lambda = w; v = vtmp; @@ -414,11 +414,11 @@ float *prwork = rwork.fortran_vec (); F77_XFCN (cheev, CHEEV, (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) { @@ -427,22 +427,22 @@ FloatComplex *pwork = work.fortran_vec (); F77_XFCN (cheev, CHEEV, (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 cheev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in cheev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("cheev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("cheev failed to converge"); + return info; + } lambda = FloatComplexColumnVector (wr); v = calc_ev ? FloatComplexMatrix (atmp) : FloatComplexMatrix (); @@ -459,7 +459,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; } @@ -484,10 +484,10 @@ float *tmp_data = tmp.fortran_vec (); F77_XFCN (spotrf, SPOTRF, (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); @@ -518,13 +518,13 @@ octave_idx_type idummy = 1; F77_XFCN (sggev, SGGEV, (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) { @@ -533,60 +533,60 @@ float *pwork = work.fortran_vec (); F77_XFCN (sggev, SGGEV, (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 sggev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in sggev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("sggev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("sggev failed to converge"); + return info; + } lambda.resize (n); v.resize (nvr, nvr); for (octave_idx_type j = 0; j < n; j++) - { - if (ai.elem (j) == 0.0) - { - lambda.elem (j) = FloatComplex (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) = FloatComplex (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) = FloatComplex (ar.elem(j) / beta.elem (j), - ai.elem(j) / beta.elem (j)); - lambda.elem(j+1) = FloatComplex (ar.elem(j+1) / beta.elem (j+1), - ai.elem(j+1) / beta.elem (j+1)); + lambda.elem(j) = FloatComplex (ar.elem(j) / beta.elem (j), + ai.elem(j) / beta.elem (j)); + lambda.elem(j+1) = FloatComplex (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++) - { - float real_part = vr.elem (i, j); - float imag_part = vr.elem (i, j+1); - v.elem (i, j) = FloatComplex (real_part, imag_part); - v.elem (i, j+1) = FloatComplex (real_part, -imag_part); - } - j++; - } - } + for (octave_idx_type i = 0; i < nvr; i++) + { + float real_part = vr.elem (i, j); + float imag_part = vr.elem (i, j+1); + v.elem (i, j) = FloatComplex (real_part, imag_part); + v.elem (i, j+1) = FloatComplex (real_part, -imag_part); + } + j++; + } + } } else (*current_liboctave_error_handler) ("sggev workspace query failed"); @@ -627,12 +627,12 @@ float dummy_work; F77_XFCN (ssygv, SSYGV, (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) { @@ -641,24 +641,24 @@ float *pwork = work.fortran_vec (); F77_XFCN (ssygv, SSYGV, (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 ssygv"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in ssygv"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("ssygv failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("ssygv failed to converge"); + return info; + } lambda = FloatComplexColumnVector (wr); v = calc_ev ? FloatComplexMatrix (atmp) : FloatComplexMatrix (); @@ -675,7 +675,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; } @@ -700,10 +700,10 @@ FloatComplex *tmp_data = tmp.fortran_vec (); F77_XFCN (cpotrf, CPOTRF, (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); @@ -735,12 +735,12 @@ octave_idx_type idummy = 1; F77_XFCN (cggev, CGGEV, (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) { @@ -749,24 +749,24 @@ FloatComplex *pwork = work.fortran_vec (); F77_XFCN (cggev, CGGEV, (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 cggev"); - return info; - } + { + (*current_liboctave_error_handler) ("unrecoverable error in cggev"); + return info; + } if (info > 0) - { - (*current_liboctave_error_handler) ("cggev failed to converge"); - return info; - } + { + (*current_liboctave_error_handler) ("cggev failed to converge"); + return info; + } lambda.resize (n); @@ -818,13 +818,13 @@ float *prwork = rwork.fortran_vec (); F77_XFCN (chegv, CHEGV, (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) { @@ -833,24 +833,24 @@ FloatComplex *pwork = work.fortran_vec (); F77_XFCN (chegv, CHEGV, (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 = FloatComplexColumnVector (wr); v = calc_ev ? FloatComplexMatrix (atmp) : FloatComplexMatrix ();
--- a/liboctave/fMatrix.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fMatrix.cc Thu Feb 11 12:23:32 2010 -0500 @@ -63,151 +63,151 @@ { 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 (sgebal, SGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgebak, SGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, float*, 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&, float*, + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgemm, SGEMM) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const float&, const float*, const octave_idx_type&, - const float*, const octave_idx_type&, const float&, - float*, 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 float&, const float*, const octave_idx_type&, + const float*, const octave_idx_type&, const float&, + float*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgemv, SGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const float&, - const float*, const octave_idx_type&, const float*, - const octave_idx_type&, const float&, float*, - const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const float&, + const float*, const octave_idx_type&, const float*, + const octave_idx_type&, const float&, float*, + const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xsdot, XSDOT) (const octave_idx_type&, const float*, const octave_idx_type&, - const float*, const octave_idx_type&, float&); + const float*, const octave_idx_type&, float&); F77_RET_T F77_FUNC (ssyrk, SSYRK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, - const float&, const float*, const octave_idx_type&, - const float&, float*, 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 float&, const float*, const octave_idx_type&, + const float&, float*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgetrf, SGETRF) (const octave_idx_type&, const octave_idx_type&, float*, const octave_idx_type&, - octave_idx_type*, octave_idx_type&); + octave_idx_type*, octave_idx_type&); F77_RET_T F77_FUNC (sgetrs, SGETRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, const octave_idx_type&, - const float*, const octave_idx_type&, - const octave_idx_type*, float*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const float*, const octave_idx_type&, + const octave_idx_type*, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgetri, SGETRI) (const octave_idx_type&, float*, const octave_idx_type&, const octave_idx_type*, - float*, const octave_idx_type&, octave_idx_type&); + float*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (sgecon, SGECON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, float*, - const octave_idx_type&, const float&, float&, - float*, octave_idx_type*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const float&, float&, + float*, octave_idx_type*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgelsy, SGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - float*, const octave_idx_type&, float*, - const octave_idx_type&, octave_idx_type*, float&, octave_idx_type&, - float*, const octave_idx_type&, octave_idx_type&); + float*, const octave_idx_type&, float*, + const octave_idx_type&, octave_idx_type*, float&, octave_idx_type&, + float*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (sgelsd, SGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - float*, const octave_idx_type&, float*, - const octave_idx_type&, float*, float&, octave_idx_type&, - float*, const octave_idx_type&, octave_idx_type*, - octave_idx_type&); + float*, const octave_idx_type&, float*, + const octave_idx_type&, float*, float&, octave_idx_type&, + float*, const octave_idx_type&, octave_idx_type*, + octave_idx_type&); F77_RET_T F77_FUNC (spotrf, SPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - float *, const octave_idx_type&, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + float *, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (spocon, SPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - float*, const octave_idx_type&, const float&, - float&, float*, octave_idx_type*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + float*, const octave_idx_type&, const float&, + float&, float*, octave_idx_type*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (spotrs, SPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const float*, - const octave_idx_type&, float*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const float*, + const octave_idx_type&, float*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (strtri, STRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const float*, - const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const float*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (strcon, STRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const float*, const octave_idx_type&, float&, - float*, 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 float*, const octave_idx_type&, float&, + float*, 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 (strtrs, STRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const float*, - const octave_idx_type&, float*, - 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 float*, + const octave_idx_type&, float*, + 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 (slartg, SLARTG) (const float&, const float&, float&, - float&, float&); + float&, float&); F77_RET_T F77_FUNC (strsyl, STRSYL) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - const float*, const octave_idx_type&, const float*, - const octave_idx_type&, const float*, const octave_idx_type&, - float&, 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 float*, const octave_idx_type&, const float*, + const octave_idx_type&, const float*, const octave_idx_type&, + float&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xslange, XSLANGE) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - const octave_idx_type&, const float*, - const octave_idx_type&, float*, float& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const float*, + const octave_idx_type&, float*, float& + F77_CHAR_ARG_LEN_DECL); } // Matrix class. @@ -282,9 +282,9 @@ if (is_square () && rows () > 0) { for (octave_idx_type i = 0; i < rows (); i++) - for (octave_idx_type j = i+1; j < cols (); j++) - if (elem (i, j) != elem (j, i)) - return false; + for (octave_idx_type j = i+1; j < cols (); j++) + if (elem (i, j) != elem (j, i)) + return false; return true; } @@ -315,7 +315,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; @@ -337,7 +337,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; @@ -364,7 +364,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; @@ -381,8 +381,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; @@ -409,8 +409,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; @@ -496,7 +496,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return FloatMatrix (); } @@ -515,7 +515,7 @@ if (nc != a.length ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return FloatMatrix (); } @@ -534,7 +534,7 @@ if (nc != 1) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return FloatMatrix (); } @@ -553,7 +553,7 @@ if (nc != a.cols ()) { (*current_liboctave_error_handler) - ("column dimension mismatch for stack"); + ("column dimension mismatch for stack"); return FloatMatrix (); } @@ -641,7 +641,7 @@ FloatMatrix FloatMatrix::inverse (octave_idx_type& info, float& rcon, int force, - int calc_cond) const + int calc_cond) const { MatrixType mattype (*this); return inverse (mattype, info, rcon, force, calc_cond); @@ -664,7 +664,7 @@ FloatMatrix FloatMatrix::tinverse (MatrixType &mattype, octave_idx_type& info, float& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { FloatMatrix retval; @@ -682,38 +682,38 @@ float *tmp_data = retval.fortran_vec (); F77_XFCN (strtri, STRTRI, (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 dtrcon_info = 0; - char job = '1'; - - OCTAVE_LOCAL_BUFFER (float, work, 3 * nr); - OCTAVE_LOCAL_BUFFER (octave_idx_type, iwork, nr); - - F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&udiag, 1), - nr, tmp_data, nr, rcon, - work, iwork, dtrcon_info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (dtrcon_info != 0) - info = -1; - } + { + octave_idx_type dtrcon_info = 0; + char job = '1'; + + OCTAVE_LOCAL_BUFFER (float, work, 3 * nr); + OCTAVE_LOCAL_BUFFER (octave_idx_type, iwork, nr); + + F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&udiag, 1), + nr, tmp_data, nr, rcon, + work, iwork, dtrcon_info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (dtrcon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore matrix contents. + retval = *this; // Restore matrix contents. } return retval; @@ -722,7 +722,7 @@ FloatMatrix FloatMatrix::finverse (MatrixType &mattype, octave_idx_type& info, float& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { FloatMatrix retval; @@ -744,7 +744,7 @@ // Query the optimum work array size. F77_XFCN (sgetri, SGETRI, (nc, tmp_data, nr, pipvt, - z.fortran_vec (), lwork, info)); + z.fortran_vec (), lwork, info)); lwork = static_cast<octave_idx_type> (z(0)); lwork = (lwork < 2 *nc ? 2*nc : lwork); @@ -756,46 +756,46 @@ // Calculate the norm of the matrix, for later use. float anorm = 0; 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 (sgetrf, SGETRF, (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) - { - octave_idx_type dgecon_info = 0; - - // Now calculate the condition number for non-singular matrix. - char job = '1'; - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, dgecon_info - F77_CHAR_ARG_LEN (1))); - - if (dgecon_info != 0) - info = -1; - } + { + octave_idx_type dgecon_info = 0; + + // Now calculate the condition number for non-singular matrix. + char job = '1'; + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, dgecon_info + F77_CHAR_ARG_LEN (1))); + + if (dgecon_info != 0) + info = -1; + } if (info == -1 && ! force) - retval = *this; // Restore matrix contents. + retval = *this; // Restore matrix contents. else - { - octave_idx_type dgetri_info = 0; - - F77_XFCN (sgetri, SGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, dgetri_info)); - - if (dgetri_info != 0) - info = -1; - } + { + octave_idx_type dgetri_info = 0; + + F77_XFCN (sgetri, SGETRI, (nc, tmp_data, nr, pipvt, + pz, lwork, dgetri_info)); + + if (dgetri_info != 0) + info = -1; + } if (info != 0) - mattype.mark_as_rectangular(); + mattype.mark_as_rectangular(); } return retval; @@ -803,7 +803,7 @@ FloatMatrix FloatMatrix::inverse (MatrixType &mattype, octave_idx_type& info, float& rcon, - int force, int calc_cond) const + int force, int calc_cond) const { int typ = mattype.type (false); FloatMatrix ret; @@ -816,25 +816,25 @@ else { if (mattype.is_hermitian ()) - { - FloatCHOL 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 (); - } + { + FloatCHOL 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 = FloatMatrix (rows (), columns (), octave_Float_Inf); + ret = FloatMatrix (rows (), columns (), octave_Float_Inf); } return ret; @@ -858,9 +858,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) @@ -1122,12 +1122,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 (cfftf, CFFTF) (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; @@ -1191,12 +1191,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 (cfftb, CFFTB) (npts, prow, pwsave); for (octave_idx_type i = 0; i < npts; i++) - tmp_data[i*nr + j] = prow[i] / static_cast<float> (npts); + tmp_data[i*nr + j] = prow[i] / static_cast<float> (npts); } return retval; @@ -1383,143 +1383,143 @@ 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 float *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } + { + const float *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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_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 float *tmp_data = fortran_vec (); - octave_idx_type info = 0; - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } + { + const float *tmp_data = fortran_vec (); + octave_idx_type info = 0; + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, 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) - { - float anorm = -1.0; - FloatMatrix atmp = *this; - float *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 (spotrf, SPOTRF, (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<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, piz, 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<float> z (4 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (sgetrf, SGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (info != 0) - { - rcon = 0.0; - mattype.mark_as_rectangular (); - } - else - { - char job = '1'; - F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - rcon = 0.0; - } - } - } + { + float anorm = -1.0; + FloatMatrix atmp = *this; + float *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 (spotrf, SPOTRF, (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<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, piz, 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<float> z (4 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (sgetrf, SGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (info != 0) + { + rcon = 0.0; + mattype.mark_as_rectangular (); + } + else + { + char job = '1'; + F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + rcon = 0.0; + } + } + } else - rcon = 0.0; + rcon = 0.0; } return rcon; @@ -1527,8 +1527,8 @@ FloatMatrix FloatMatrix::utsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { FloatMatrix retval; @@ -1545,81 +1545,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 float *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'U'; - char dia = 'N'; - - Array<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile float 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; - float *result = retval.fortran_vec (); - - char uplo = 'U'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (strtrs, STRTRS, (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 float *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile float 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; + float *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (strtrs, STRTRS, (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; @@ -1627,8 +1627,8 @@ FloatMatrix FloatMatrix::ltsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool calc_cond, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, + bool calc_cond, blas_trans_type transt) const { FloatMatrix retval; @@ -1645,81 +1645,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 float *tmp_data = fortran_vec (); - - if (calc_cond) - { - char norm = '1'; - char uplo = 'L'; - char dia = 'N'; - - Array<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), - F77_CONST_CHAR_ARG2 (&uplo, 1), - F77_CONST_CHAR_ARG2 (&dia, 1), - nr, tmp_data, nr, rcon, - pz, piz, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile float 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; - float *result = retval.fortran_vec (); - - char uplo = 'L'; - char trans = get_blas_char (transt); - char dia = 'N'; - - F77_XFCN (strtrs, STRTRS, (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 float *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcon, + pz, piz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile float 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; + float *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = get_blas_char (transt); + char dia = 'N'; + + F77_XFCN (strtrs, STRTRS, (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; @@ -1727,8 +1727,8 @@ FloatMatrix FloatMatrix::fsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool calc_cond) const + float& rcon, solve_singularity_handler sing_handler, + bool calc_cond) const { FloatMatrix retval; @@ -1748,160 +1748,160 @@ float anorm = -1.; if (typ == MatrixType::Hermitian) - { - info = 0; - char job = 'L'; - FloatMatrix atmp = *this; - float *tmp_data = atmp.fortran_vec (); - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (spotrf, SPOTRF, (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<float> z (3 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, tmp_data, nr, anorm, - rcon, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile float 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; - float *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - F77_XFCN (spotrs, SPOTRS, (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'; + FloatMatrix atmp = *this; + float *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (spotrf, SPOTRF, (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<float> z (3 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcon, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile float 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; + float *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (spotrs, SPOTRS, (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 (); - - FloatMatrix atmp = *this; - float *tmp_data = atmp.fortran_vec (); - if(anorm < 0.) - anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - Array<float> z (4 * nc); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - F77_XFCN (sgetrf, SGETRF, (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 (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcon, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (info != 0) - info = -2; - - volatile float 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; - float *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - char job = 'N'; - F77_XFCN (sgetrs, SGETRS, (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 (); + + FloatMatrix atmp = *this; + float *tmp_data = atmp.fortran_vec (); + if(anorm < 0.) + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + Array<float> z (4 * nc); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (sgetrf, SGETRF, (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 (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcon, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (info != 0) + info = -2; + + volatile float 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; + float *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (sgetrs, SGETRS, (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 (); + } + } else if (typ != MatrixType::Hermitian) - (*current_liboctave_error_handler) ("incorrect matrix type"); + (*current_liboctave_error_handler) ("incorrect matrix type"); } return retval; @@ -1924,15 +1924,15 @@ FloatMatrix FloatMatrix::solve (MatrixType &typ, const FloatMatrix& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (typ, b, info, rcon, 0); } FloatMatrix FloatMatrix::solve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { FloatMatrix retval; int typ = mattype.type (); @@ -1983,7 +1983,7 @@ FloatComplexMatrix FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (typ, b, info, rcon, 0); } @@ -2017,8 +2017,8 @@ FloatComplexMatrix FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, - bool singular_fallback, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, + bool singular_fallback, blas_trans_type transt) const { FloatMatrix tmp = stack_complex_matrix (b); tmp = solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt); @@ -2034,7 +2034,7 @@ FloatColumnVector FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { float rcon; return solve (typ, b, info, rcon); @@ -2042,14 +2042,14 @@ FloatColumnVector FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, octave_idx_type& info, - float& rcon) const + float& rcon) const { return solve (typ, b, info, rcon, 0); } FloatColumnVector FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatMatrix tmp (b); return solve (typ, tmp, info, rcon, sing_handler, transt).column(static_cast<octave_idx_type> (0)); @@ -2064,7 +2064,7 @@ FloatComplexColumnVector FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info) const + octave_idx_type& info) const { FloatComplexMatrix tmp (*this); return tmp.solve (typ, b, info); @@ -2072,7 +2072,7 @@ FloatComplexColumnVector FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info, float& rcon) const + octave_idx_type& info, float& rcon) const { FloatComplexMatrix tmp (*this); return tmp.solve (typ, b, info, rcon); @@ -2080,8 +2080,8 @@ FloatComplexColumnVector FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, - octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + octave_idx_type& info, float& rcon, + solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatComplexMatrix tmp (*this); return tmp.solve(typ, b, info, rcon, sing_handler, transt); @@ -2110,7 +2110,7 @@ FloatMatrix FloatMatrix::solve (const FloatMatrix& b, octave_idx_type& info, - float& rcon, solve_singularity_handler sing_handler, blas_trans_type transt) const + float& rcon, solve_singularity_handler sing_handler, blas_trans_type transt) const { MatrixType mattype (*this); return solve (mattype, b, info, rcon, sing_handler, true, transt); @@ -2139,7 +2139,7 @@ FloatComplexMatrix FloatMatrix::solve (const FloatComplexMatrix& b, octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatComplexMatrix tmp (*this); return tmp.solve (b, info, rcon, sing_handler, transt); @@ -2167,7 +2167,7 @@ FloatColumnVector FloatMatrix::solve (const FloatColumnVector& b, octave_idx_type& info, float& 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, transt); @@ -2196,7 +2196,7 @@ FloatComplexColumnVector FloatMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info, float& rcon, - solve_singularity_handler sing_handler, blas_trans_type transt) const + solve_singularity_handler sing_handler, blas_trans_type transt) const { FloatComplexMatrix tmp (*this); return tmp.solve (b, info, rcon, sing_handler, transt); @@ -2221,7 +2221,7 @@ FloatMatrix FloatMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (b, info, rank, rcon); @@ -2229,7 +2229,7 @@ FloatMatrix FloatMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, - octave_idx_type& rank, float &rcon) const + octave_idx_type& rank, float &rcon) const { FloatMatrix retval; @@ -2249,15 +2249,15 @@ octave_idx_type maxmn = m > n ? m : n; rcon = -1.0; if (m != n) - { - retval = FloatMatrix (maxmn, nrhs, 0.0); - - 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 = FloatMatrix (maxmn, nrhs, 0.0); + + 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; FloatMatrix atmp = *this; float *tmp_data = atmp.fortran_vec (); @@ -2273,17 +2273,17 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("SGELSD", 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 ("SGELSD", 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 iwork because DGELSD in older versions // of LAPACK does not return it on a query call. @@ -2296,70 +2296,70 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; 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 (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, 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 DGELSD to operate // efficiently. if (n >= mnthr) - { - const octave_idx_type wlalsd - = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs + (smlsiz+1)*(smlsiz+1); - - 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; - - if (wlalsd > addend) - addend = wlalsd; - - const octave_idx_type lworkaround = 4*m + m*m + addend; - - if (work(0) < lworkaround) - work(0) = lworkaround; - } + { + const octave_idx_type wlalsd + = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs + (smlsiz+1)*(smlsiz+1); + + 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; + + if (wlalsd > addend) + addend = wlalsd; + + const octave_idx_type lworkaround = 4*m + m*m + addend; + + if (work(0) < lworkaround) + work(0) = lworkaround; + } else if (m >= n) - { - octave_idx_type lworkaround - = 12*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs + (smlsiz+1)*(smlsiz+1); - - if (work(0) < lworkaround) - work(0) = lworkaround; - } + { + octave_idx_type lworkaround + = 12*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs + (smlsiz+1)*(smlsiz+1); + + if (work(0) < lworkaround) + work(0) = lworkaround; + } lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + piwork, info)); if (rank < minmn) - (*current_liboctave_warning_handler) - ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); + (*current_liboctave_warning_handler) + ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); 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); } @@ -2388,7 +2388,7 @@ FloatComplexMatrix FloatMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { FloatComplexMatrix tmp (*this); float rcon; @@ -2397,7 +2397,7 @@ FloatComplexMatrix FloatMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, - octave_idx_type& rank, float& rcon) const + octave_idx_type& rank, float& rcon) const { FloatComplexMatrix tmp (*this); return tmp.lssolve (b, info, rank, rcon); @@ -2422,7 +2422,7 @@ FloatColumnVector FloatMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { float rcon; return lssolve (b, info, rank, rcon); @@ -2430,7 +2430,7 @@ FloatColumnVector FloatMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, float &rcon) const + octave_idx_type& rank, float &rcon) const { FloatColumnVector retval; @@ -2451,14 +2451,14 @@ rcon = -1.0; if (m != n) - { - retval = FloatColumnVector (maxmn, 0.0); - - for (octave_idx_type i = 0; i < m; i++) - retval.elem (i) = b.elem (i); - } + { + retval = FloatColumnVector (maxmn, 0.0); + + for (octave_idx_type i = 0; i < m; i++) + retval.elem (i) = b.elem (i); + } else - retval = b; + retval = b; FloatMatrix atmp = *this; float *tmp_data = atmp.fortran_vec (); @@ -2474,10 +2474,10 @@ octave_idx_type smlsiz; F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("SGELSD", 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 iwork because DGELSD in older versions // of LAPACK does not return it on a query call. @@ -2490,36 +2490,36 @@ #endif octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; if (nlvl < 0) - nlvl = 0; + nlvl = 0; 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 (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, - ps, rcon, rank, work.fortran_vec (), - lwork, piwork, info)); + ps, rcon, rank, work.fortran_vec (), + lwork, piwork, info)); lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, - maxmn, ps, rcon, rank, - work.fortran_vec (), lwork, - piwork, info)); + maxmn, ps, rcon, rank, + work.fortran_vec (), lwork, + piwork, info)); if (rank < minmn) - { - if (rank < minmn) - (*current_liboctave_warning_handler) - ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); - if (s.elem (0) == 0.0) - rcon = 0.0; - else - rcon = s.elem (minmn - 1) / s.elem (0); - } + { + if (rank < minmn) + (*current_liboctave_warning_handler) + ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); + if (s.elem (0) == 0.0) + rcon = 0.0; + else + rcon = s.elem (minmn - 1) / s.elem (0); + } retval.resize (n, nrhs); } @@ -2548,7 +2548,7 @@ FloatComplexColumnVector FloatMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank) const + octave_idx_type& rank) const { FloatComplexMatrix tmp (*this); float rcon; @@ -2557,7 +2557,7 @@ FloatComplexColumnVector FloatMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, - octave_idx_type& rank, float &rcon) const + octave_idx_type& rank, float &rcon) const { FloatComplexMatrix tmp (*this); return tmp.lssolve (b, info, rank, rcon); @@ -2628,13 +2628,13 @@ retval = FloatMatrix (len, a_len); float *c = retval.fortran_vec (); - + F77_XFCN (sgemm, SGEMM, (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; @@ -2650,14 +2650,14 @@ if (neg_zero) { for (octave_idx_type i = 0; i < nel; i++) - if (lo_ieee_signbit (elem (i))) - return true; + if (lo_ieee_signbit (elem (i))) + return true; } else { for (octave_idx_type i = 0; i < nel; i++) - if (elem (i) < 0) - return true; + if (elem (i) < 0) + return true; } return false; @@ -2672,7 +2672,7 @@ { float val = elem (i); if (xisnan (val)) - return true; + return true; } return false; @@ -2687,7 +2687,7 @@ { float val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -2702,7 +2702,7 @@ { float val = elem (i); if (val != 0 && val != 1) - return true; + return true; } return false; @@ -2717,9 +2717,9 @@ { float val = elem (i); if (xisnan (val) || D_NINT (val) == val) - continue; + continue; else - return false; + return false; } return true; @@ -2746,13 +2746,13 @@ float val = elem (i); if (val > max_val) - max_val = val; + max_val = val; if (val < min_val) - min_val = val; + min_val = val; if (D_NINT (val) != val) - return false; + return false; } return true; @@ -2768,8 +2768,8 @@ float val = elem (i); if (! (xisnan (val) || xisinf (val)) - && fabs (val) > FLT_MAX) - return true; + && fabs (val) > FLT_MAX) + return true; } return false; @@ -2855,33 +2855,33 @@ for (octave_idx_type i = 0; i < nr; i++) { - octave_idx_type idx_j; - - float tmp_min = octave_Float_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_min = elem (i, idx_j); - - if (! xisnan (tmp_min)) - break; - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - float tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp < tmp_min) - { - idx_j = j; - tmp_min = tmp; - } - } - - result.elem (i) = tmp_min; - idx_arg.elem (i) = xisnan (tmp_min) ? 0 : idx_j; + octave_idx_type idx_j; + + float tmp_min = octave_Float_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_min = elem (i, idx_j); + + if (! xisnan (tmp_min)) + break; + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + float tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp < tmp_min) + { + idx_j = j; + tmp_min = tmp; + } + } + + result.elem (i) = tmp_min; + idx_arg.elem (i) = xisnan (tmp_min) ? 0 : idx_j; } } @@ -2910,33 +2910,33 @@ for (octave_idx_type i = 0; i < nr; i++) { - octave_idx_type idx_j; - - float tmp_max = octave_Float_NaN; - - for (idx_j = 0; idx_j < nc; idx_j++) - { - tmp_max = elem (i, idx_j); - - if (! xisnan (tmp_max)) - break; - } - - for (octave_idx_type j = idx_j+1; j < nc; j++) - { - float tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp > tmp_max) - { - idx_j = j; - tmp_max = tmp; - } - } - - result.elem (i) = tmp_max; - idx_arg.elem (i) = xisnan (tmp_max) ? 0 : idx_j; + octave_idx_type idx_j; + + float tmp_max = octave_Float_NaN; + + for (idx_j = 0; idx_j < nc; idx_j++) + { + tmp_max = elem (i, idx_j); + + if (! xisnan (tmp_max)) + break; + } + + for (octave_idx_type j = idx_j+1; j < nc; j++) + { + float tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp > tmp_max) + { + idx_j = j; + tmp_max = tmp; + } + } + + result.elem (i) = tmp_max; + idx_arg.elem (i) = xisnan (tmp_max) ? 0 : idx_j; } } @@ -2965,33 +2965,33 @@ for (octave_idx_type j = 0; j < nc; j++) { - octave_idx_type idx_i; - - float tmp_min = octave_Float_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_min = elem (idx_i, j); - - if (! xisnan (tmp_min)) - break; - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - float tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp < tmp_min) - { - idx_i = i; - tmp_min = tmp; - } - } - - result.elem (j) = tmp_min; - idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_i; + octave_idx_type idx_i; + + float tmp_min = octave_Float_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_min = elem (idx_i, j); + + if (! xisnan (tmp_min)) + break; + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + float tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp < tmp_min) + { + idx_i = i; + tmp_min = tmp; + } + } + + result.elem (j) = tmp_min; + idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_i; } } @@ -3020,33 +3020,33 @@ for (octave_idx_type j = 0; j < nc; j++) { - octave_idx_type idx_i; - - float tmp_max = octave_Float_NaN; - - for (idx_i = 0; idx_i < nr; idx_i++) - { - tmp_max = elem (idx_i, j); - - if (! xisnan (tmp_max)) - break; - } - - for (octave_idx_type i = idx_i+1; i < nr; i++) - { - float tmp = elem (i, j); - - if (xisnan (tmp)) - continue; - else if (tmp > tmp_max) - { - idx_i = i; - tmp_max = tmp; - } - } - - result.elem (j) = tmp_max; - idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_i; + octave_idx_type idx_i; + + float tmp_max = octave_Float_NaN; + + for (idx_i = 0; idx_i < nr; idx_i++) + { + tmp_max = elem (idx_i, j); + + if (! xisnan (tmp_max)) + break; + } + + for (octave_idx_type i = idx_i+1; i < nr; i++) + { + float tmp = elem (i, j); + + if (xisnan (tmp)) + continue; + else if (tmp > tmp_max) + { + idx_i = i; + tmp_max = tmp; + } + } + + result.elem (j) = tmp_max; + idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_i; } } @@ -3059,10 +3059,10 @@ for (octave_idx_type i = 0; i < a.rows (); i++) { for (octave_idx_type j = 0; j < a.cols (); j++) - { - os << " "; - octave_write_float (os, a.elem (i, j)); - } + { + os << " "; + octave_write_float (os, a.elem (i, j)); + } os << "\n"; } return os; @@ -3078,14 +3078,14 @@ { float tmp; for (octave_idx_type i = 0; i < nr; i++) - for (octave_idx_type j = 0; j < nc; j++) - { - tmp = octave_read_value<float> (is); - if (is) - a.elem (i, j) = tmp; - else - goto done; - } + for (octave_idx_type j = 0; j < nc; j++) + { + tmp = octave_read_value<float> (is); + if (is) + a.elem (i, j) = tmp; + else + goto done; + } } done: @@ -3147,11 +3147,11 @@ float *px = cx.fortran_vec (); F77_XFCN (strsyl, STRSYL, (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? @@ -3209,13 +3209,13 @@ else { if (a_nr == 0 || a_nc == 0 || b_nc == 0) - retval = FloatMatrix (a_nr, b_nc, 0.0); + retval = FloatMatrix (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 = FloatMatrix (a_nr, b_nc); - float *c = retval.fortran_vec (); + float *c = retval.fortran_vec (); const char *ctra = get_blas_trans_arg (tra); F77_XFCN (ssyrk, SSYRK, (F77_CONST_CHAR_ARG2 ("U", 1), @@ -3230,25 +3230,25 @@ } else - { - octave_idx_type lda = a.rows (), tda = a.cols (); - octave_idx_type ldb = b.rows (), tdb = b.cols (); - - retval = FloatMatrix (a_nr, b_nc); - float *c = retval.fortran_vec (); - - if (b_nc == 1) - { - if (a_nr == 1) - F77_FUNC (xsdot, XSDOT) (a_nc, a.data (), 1, b.data (), 1, *c); - else - { + { + octave_idx_type lda = a.rows (), tda = a.cols (); + octave_idx_type ldb = b.rows (), tdb = b.cols (); + + retval = FloatMatrix (a_nr, b_nc); + float *c = retval.fortran_vec (); + + if (b_nc == 1) + { + if (a_nr == 1) + F77_FUNC (xsdot, XSDOT) (a_nc, a.data (), 1, b.data (), 1, *c); + else + { const char *ctra = get_blas_trans_arg (tra); - F77_XFCN (sgemv, SGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), - lda, tda, 1.0, a.data (), lda, - b.data (), 1, 0.0, c, 1 - F77_CHAR_ARG_LEN (1))); - } + F77_XFCN (sgemv, SGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), + lda, tda, 1.0, a.data (), lda, + b.data (), 1, 0.0, c, 1 + F77_CHAR_ARG_LEN (1))); + } } else if (a_nr == 1) { @@ -3258,18 +3258,18 @@ a.data (), 1, 0.0, c, 1 F77_CHAR_ARG_LEN (1))); } - else - { + else + { const char *ctra = get_blas_trans_arg (tra); const char *ctrb = get_blas_trans_arg (trb); - F77_XFCN (sgemm, SGEMM, (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 (sgemm, SGEMM, (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; @@ -3301,8 +3301,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 (d, m (i, j)); + octave_quit (); + result (i, j) = xmin (d, m (i, j)); } return result; @@ -3321,8 +3321,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), d); + octave_quit (); + result (i, j) = xmin (m (i, j), d); } return result; @@ -3337,7 +3337,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 FloatMatrix (); } @@ -3348,8 +3348,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 (a (i, j), b (i, j)); + octave_quit (); + result (i, j) = xmin (a (i, j), b (i, j)); } return result; @@ -3368,8 +3368,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 (d, m (i, j)); + octave_quit (); + result (i, j) = xmax (d, m (i, j)); } return result; @@ -3388,8 +3388,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), d); + octave_quit (); + result (i, j) = xmax (m (i, j), d); } return result; @@ -3404,7 +3404,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 FloatMatrix (); } @@ -3415,8 +3415,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 (a (i, j), b (i, j)); + octave_quit (); + result (i, j) = xmax (a (i, j), b (i, j)); } return result;
--- a/liboctave/fNDArray.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -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; } @@ -111,7 +111,7 @@ // Need to be careful here about the distance between fft's for (octave_idx_type k = 0; k < nloop; k++) octave_fftw::ifft (out + k * stride * n, out + k * stride * n, - n, howmany, stride, dist); + n, howmany, stride, dist); return retval; } @@ -236,17 +236,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 (cfftf, CFFTF) (npts, tmp, pwsave); + F77_FUNC (cfftf, CFFTF) (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; @@ -283,18 +283,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 (cfftb, CFFTB) (npts, tmp, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, tmp, pwsave); - for (octave_idx_type i = 0; i < npts; i++) - retval ((i + k*npts)*stride + j*dist) = tmp[i] / - static_cast<float> (npts); - } + for (octave_idx_type i = 0; i < npts; i++) + retval ((i + k*npts)*stride + j*dist) = tmp[i] / + static_cast<float> (npts); + } } return retval; @@ -320,27 +320,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 (cffti, CFFTI) (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 (cfftf, CFFTF) (npts, prow, pwsave); + F77_FUNC (cfftf, CFFTF) (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); } @@ -368,28 +368,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 (cffti, CFFTI) (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 (cfftb, CFFTB) (npts, prow, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<float> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<float> (npts); + } + } stride *= dv2(i); } @@ -416,27 +416,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 (cffti, CFFTI) (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 (cfftf, CFFTF) (npts, prow, pwsave); + F77_FUNC (cfftf, CFFTF) (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); } @@ -463,28 +463,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 (cffti, CFFTI) (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 (cfftb, CFFTB) (npts, prow, pwsave); + F77_FUNC (cfftb, CFFTB) (npts, prow, pwsave); - for (octave_idx_type l = 0; l < npts; l++) - retval ((l + k*npts)*stride + j*dist) = prow[l] / - static_cast<float> (npts); - } - } + for (octave_idx_type l = 0; l < npts; l++) + retval ((l + k*npts)*stride + j*dist) = prow[l] / + static_cast<float> (npts); + } + } stride *= dv(i); } @@ -510,8 +510,8 @@ if (neg_zero) { for (octave_idx_type i = 0; i < nel; i++) - if (lo_ieee_signbit (elem (i))) - return true; + if (lo_ieee_signbit (elem (i))) + return true; } else return mx_inline_any_negative (numel (), data ()); @@ -528,7 +528,7 @@ { float val = elem (i); if (xisnan (val)) - return true; + return true; } return false; @@ -543,7 +543,7 @@ { float val = elem (i); if (xisinf (val) || xisnan (val)) - return true; + return true; } return false; @@ -558,7 +558,7 @@ { float val = elem (i); if (val != 0 && val != 1) - return true; + return true; } return false; @@ -585,9 +585,9 @@ { float val = elem (i); if (xisnan (val) || D_NINT (val) == val) - continue; + continue; else - return false; + return false; } return true; @@ -614,13 +614,13 @@ float val = elem (i); if (val > max_val) - max_val = val; + max_val = val; if (val < min_val) - min_val = val; + min_val = val; if (D_NINT (val) != val) - return false; + return false; } return true; @@ -636,7 +636,7 @@ double val = elem (i); if (D_NINT (val) != val) - return false; + return false; } return true; @@ -652,8 +652,8 @@ float val = elem (i); if (! (xisnan (val) || xisinf (val)) - && fabs (val) > FLT_MAX) - return true; + && fabs (val) > FLT_MAX) + return true; } return false; @@ -791,22 +791,22 @@ float d = elem (i); if (xisnan (d)) - { - (*current_liboctave_error_handler) - ("invalid conversion from NaN to character"); - return retval; - } + { + (*current_liboctave_error_handler) + ("invalid conversion from NaN to character"); + return retval; + } 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; - retval.elem (i) = static_cast<char>(ival); - } + retval.elem (i) = static_cast<char>(ival); + } } if (rb.numel () == 0) @@ -882,15 +882,15 @@ void FloatNDArray::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 FloatNDArray::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); } @@ -925,13 +925,13 @@ { float tmp; for (octave_idx_type i = 0; i < nel; i++) - { - tmp = octave_read_value<float> (is); - if (is) - a.elem (i) = tmp; - else - goto done; - } + { + tmp = octave_read_value<float> (is); + if (is) + a.elem (i) = tmp; + else + goto done; + } } done:
--- a/liboctave/fRowVector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/fRowVector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,13 +42,13 @@ { F77_RET_T F77_FUNC (sgemv, SGEMV) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const float&, - const float*, const octave_idx_type&, const float*, - const octave_idx_type&, const float&, float*, const octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, const octave_idx_type&, const float&, + const float*, const octave_idx_type&, const float*, + const octave_idx_type&, const float&, float*, const octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (xsdot, XSDOT) (const octave_idx_type&, const float*, const octave_idx_type&, - const float*, const octave_idx_type&, float&); + const float*, const octave_idx_type&, float&); } // Row Vector class. @@ -84,7 +84,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; @@ -100,7 +100,7 @@ make_unique (); for (octave_idx_type i = 0; i < len; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -124,7 +124,7 @@ make_unique (); for (octave_idx_type i = c1; i <= c2; i++) - xelem (i) = val; + xelem (i) = val; } return *this; @@ -210,21 +210,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); - float *y = retval.fortran_vec (); + retval.resize (a_nc); + float *y = retval.fortran_vec (); - F77_XFCN (sgemv, SGEMV, (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 (sgemv, SGEMV, (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;
--- a/liboctave/file-stat.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/file-stat.cc Thu Feb 11 12:23:32 2010 -0500 @@ -191,7 +191,7 @@ #if defined (__WIN32__) // Remove trailing slash. if (file_ops::is_dir_sep (full_file_name[full_file_name.length () - 1]) - && full_file_name.length () != 1 + && full_file_name.length () != 1 && ! (full_file_name.length() == 3 && full_file_name[1] == ':')) full_file_name.resize (full_file_name.length () - 1); #endif @@ -203,37 +203,37 @@ int status = follow_links ? stat (cname, &buf) : lstat (cname, &buf); if (status < 0) - { - using namespace std; + { + using namespace std; - fail = true; - errmsg = strerror (errno); - } + fail = true; + errmsg = strerror (errno); + } else - { - fs_mode = buf.st_mode; - fs_ino = buf.st_ino; - fs_dev = buf.st_dev; - fs_nlink = buf.st_nlink; - fs_uid = buf.st_uid; - fs_gid = buf.st_gid; - fs_size = buf.st_size; - fs_atime = buf.st_atime; - fs_mtime = buf.st_mtime; - fs_ctime = buf.st_ctime; + { + fs_mode = buf.st_mode; + fs_ino = buf.st_ino; + fs_dev = buf.st_dev; + fs_nlink = buf.st_nlink; + fs_uid = buf.st_uid; + fs_gid = buf.st_gid; + fs_size = buf.st_size; + fs_atime = buf.st_atime; + fs_mtime = buf.st_mtime; + fs_ctime = buf.st_ctime; #if defined (HAVE_STRUCT_STAT_ST_RDEV) - fs_rdev = buf.st_rdev; + fs_rdev = buf.st_rdev; #endif #if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) - fs_blksize = buf.st_blksize; + fs_blksize = buf.st_blksize; #endif #if defined (HAVE_STRUCT_STAT_ST_BLOCKS) - fs_blocks = buf.st_blocks; + fs_blocks = buf.st_blocks; #endif - } + } initialized = true; } @@ -252,37 +252,37 @@ int status = fstat (fid, &buf); if (status < 0) - { - using namespace std; + { + using namespace std; - fail = true; - errmsg = strerror (errno); - } + fail = true; + errmsg = strerror (errno); + } else - { - fs_mode = buf.st_mode; - fs_ino = buf.st_ino; - fs_dev = buf.st_dev; - fs_nlink = buf.st_nlink; - fs_uid = buf.st_uid; - fs_gid = buf.st_gid; - fs_size = buf.st_size; - fs_atime = buf.st_atime; - fs_mtime = buf.st_mtime; - fs_ctime = buf.st_ctime; + { + fs_mode = buf.st_mode; + fs_ino = buf.st_ino; + fs_dev = buf.st_dev; + fs_nlink = buf.st_nlink; + fs_uid = buf.st_uid; + fs_gid = buf.st_gid; + fs_size = buf.st_size; + fs_atime = buf.st_atime; + fs_mtime = buf.st_mtime; + fs_ctime = buf.st_ctime; #if defined (HAVE_STRUCT_STAT_ST_RDEV) - fs_rdev = buf.st_rdev; + fs_rdev = buf.st_rdev; #endif #if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) - fs_blksize = buf.st_blksize; + fs_blksize = buf.st_blksize; #endif #if defined (HAVE_STRUCT_STAT_ST_BLOCKS) - fs_blocks = buf.st_blocks; + fs_blocks = buf.st_blocks; #endif - } + } initialized = true; }
--- a/liboctave/floatAEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatAEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -35,18 +35,18 @@ { F77_RET_T F77_FUNC (sgebal, SGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgebak, SGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, const float*, const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL - F77_CHAR_ARG_LEN_DECL); + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } FloatAEPBALANCE::FloatAEPBALANCE (const FloatMatrix& a, @@ -72,8 +72,8 @@ job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B'); F77_XFCN (sgebal, SGEBAL, (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))); } FloatMatrix @@ -92,11 +92,11 @@ char side = 'R'; F77_XFCN (sgebak, SGEBAK, (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/floatCHOL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatCHOL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,19 +42,19 @@ { F77_RET_T F77_FUNC (spotrf, SPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - float*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (spotri, SPOTRI) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - float*, const octave_idx_type&, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (spocon, SPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, - float*, const octave_idx_type&, const float&, - float&, float*, octave_idx_type*, - octave_idx_type& F77_CHAR_ARG_LEN_DECL); + float*, const octave_idx_type&, const float&, + float&, float*, octave_idx_type*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); #ifdef HAVE_QRUPDATE F77_RET_T @@ -112,8 +112,8 @@ anorm = xnorm (a, 1); F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), - n, h, n, info - F77_CHAR_ARG_LEN (1))); + n, h, n, info + F77_CHAR_ARG_LEN (1))); xrcond = 0.0; if (info > 0) @@ -128,11 +128,11 @@ Array<octave_idx_type> iz (n); octave_idx_type *piz = iz.fortran_vec (); F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, piz, spocon_info - F77_CHAR_ARG_LEN (1))); + n, anorm, xrcond, pz, piz, spocon_info + F77_CHAR_ARG_LEN (1))); if (spocon_info != 0) - info = -1; + info = -1; } return info; @@ -155,21 +155,21 @@ float *v = tmp.fortran_vec(); if (info == 0) - { - F77_XFCN (spotri, SPOTRI, (F77_CONST_CHAR_ARG2 ("U", 1), n, - v, n, info - F77_CHAR_ARG_LEN (1))); + { + F77_XFCN (spotri, SPOTRI, (F77_CONST_CHAR_ARG2 ("U", 1), n, + v, 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 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) = tmp.xelem (j, i); + 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) = tmp.xelem (j, i); - retval = tmp; - } + retval = tmp; + } } else (*current_liboctave_error_handler) ("chol2inv requires square matrix");
--- a/liboctave/floatGEPBAL.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatGEPBAL.cc Thu Feb 11 12:23:32 2010 -0500 @@ -37,27 +37,27 @@ { F77_RET_T F77_FUNC (sggbal, SGGBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type& N, - float* A, const octave_idx_type& LDA, float* B, - const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, - float* LSCALE, float* RSCALE, - float* WORK, octave_idx_type& INFO - F77_CHAR_ARG_LEN_DECL); + float* A, const octave_idx_type& LDA, float* B, + const octave_idx_type& LDB, octave_idx_type& ILO, octave_idx_type& IHI, + float* LSCALE, float* RSCALE, + float* WORK, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sggbak, SGGBAK) (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 float* LSCALE, - const float* RSCALE, octave_idx_type& M, float* 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 float* LSCALE, + const float* RSCALE, octave_idx_type& M, float* V, + const octave_idx_type& LDV, octave_idx_type& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type FloatGEPBALANCE::init (const FloatMatrix& a, const FloatMatrix& 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 (sggbal, SGGBAL, (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 = FloatMatrix (n, n, 0.0); balancing_mat2 = FloatMatrix (n, n, 0.0); @@ -107,19 +107,19 @@ // first left F77_XFCN (sggbak, SGGBAK, (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 (sggbak, SGGBAK, (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/floatHESS.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatHESS.cc Thu Feb 11 12:23:32 2010 -0500 @@ -33,27 +33,27 @@ { F77_RET_T F77_FUNC (sgebal, SGEBAL) (F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, - octave_idx_type&, float*, octave_idx_type& - F77_CHAR_ARG_LEN_DECL); + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, + octave_idx_type&, float*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); F77_RET_T F77_FUNC (sgehrd, SGEHRD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - float*, const octave_idx_type&, float*, float*, - const octave_idx_type&, octave_idx_type&); + float*, const octave_idx_type&, float*, float*, + const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (sorghr, SORGHR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, - float*, const octave_idx_type&, float*, float*, - const octave_idx_type&, octave_idx_type&); + float*, const octave_idx_type&, float*, float*, + const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (sgebak, SGEBAK) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, float*, 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&, float*, + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } octave_idx_type @@ -84,8 +84,8 @@ float *pscale = scale.fortran_vec (); F77_XFCN (sgebal, SGEBAL, (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<float> tau (n-1); float *ptau = tau.fortran_vec (); @@ -94,20 +94,20 @@ float *pwork = work.fortran_vec (); F77_XFCN (sgehrd, SGEHRD, (n, ilo, ihi, h, n, ptau, pwork, - lwork, info)); + lwork, info)); unitary_hess_mat = hess_mat; float *z = unitary_hess_mat.fortran_vec (); F77_XFCN (sorghr, SORGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + lwork, info)); F77_XFCN (sgebak, SGEBAK, (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 :-)), please let @@ -116,7 +116,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/floatLU.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatLU.cc Thu Feb 11 12:23:32 2010 -0500 @@ -45,7 +45,7 @@ { F77_RET_T F77_FUNC (sgetrf, SGETRF) (const octave_idx_type&, const octave_idx_type&, float*, - 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/floatQR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatQR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,11 +42,11 @@ { F77_RET_T F77_FUNC (sgeqrf, SGEQRF) (const octave_idx_type&, const octave_idx_type&, float*, const octave_idx_type&, - float*, float*, const octave_idx_type&, octave_idx_type&); + float*, float*, const octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (sorgqr, SORGQR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, float*, float*, const octave_idx_type&, octave_idx_type&); + const octave_idx_type&, float*, float*, const octave_idx_type&, octave_idx_type&); #ifdef HAVE_QRUPDATE @@ -129,11 +129,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; } @@ -180,7 +180,7 @@ // allocate buffer and do the job. octave_idx_type lwork = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (float, work, lwork); F77_XFCN (sorgqr, SORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, work, lwork, info)); @@ -296,7 +296,7 @@ OCTAVE_LOCAL_BUFFER (float, w, kmax); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; FloatColumnVector utmp = u.column (jsi(i)); F77_XFCN (sqrinc, SQRINC, (m, n + ii, std::min (kmax, k + ii), q.fortran_vec (), q.rows (), @@ -319,7 +319,7 @@ { OCTAVE_LOCAL_BUFFER (float, w, k); F77_XFCN (sqrdec, SQRDEC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, w)); + r.fortran_vec (), r.rows (), j + 1, w)); if (k < m) { @@ -356,7 +356,7 @@ OCTAVE_LOCAL_BUFFER (float, w, k); for (volatile octave_idx_type i = 0; i < js.length (); i++) { - octave_idx_type ii = i; + octave_idx_type ii = i; F77_XFCN (sqrdec, SQRDEC, (m, n - ii, k == m ? k : k - ii, q.fortran_vec (), q.rows (), r.fortran_vec (), r.rows (), js(ii) + 1, w)); @@ -392,7 +392,7 @@ FloatRowVector utmp = u; OCTAVE_LOCAL_BUFFER (float, w, k); F77_XFCN (sqrinr, SQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), + r.fortran_vec (), r.rows (), j + 1, utmp.fortran_vec (), w)); } @@ -412,7 +412,7 @@ { OCTAVE_LOCAL_BUFFER (float, w, 2*m); F77_XFCN (sqrder, SQRDER, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, + r.fortran_vec (), r.rows (), j + 1, w)); q.resize (m - 1, m - 1);
--- a/liboctave/floatQRP.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatQRP.cc Thu Feb 11 12:23:32 2010 -0500 @@ -36,7 +36,7 @@ { F77_RET_T F77_FUNC (sgeqp3, SGEQP3) (const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, octave_idx_type*, float*, float*, + const octave_idx_type&, octave_idx_type*, float*, float*, const octave_idx_type&, octave_idx_type&); }
--- a/liboctave/floatSCHUR.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatSCHUR.cc Thu Feb 11 12:23:32 2010 -0500 @@ -35,16 +35,16 @@ { F77_RET_T F77_FUNC (sgeesx, SGEESX) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - FloatSCHUR::select_function, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, - float*, float*, float*, const octave_idx_type&, - float&, float&, float*, const octave_idx_type&, - octave_idx_type*, const octave_idx_type&, 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, + FloatSCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, + float*, float*, float*, const octave_idx_type&, + float&, float&, float*, const octave_idx_type&, + octave_idx_type*, const octave_idx_type&, 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 @@ -128,14 +128,14 @@ octave_idx_type *piwork = iwork.fortran_vec (); F77_XFCN (sgeesx, SGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, - pwork, lwork, piwork, liwork, 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, pwr, pwi, q, n, rconde, rcondv, + pwork, lwork, piwork, liwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); return info; }
--- a/liboctave/floatSVD.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/floatSVD.cc Thu Feb 11 12:23:32 2010 -0500 @@ -34,13 +34,13 @@ { F77_RET_T F77_FUNC (sgesvd, SGESVD) (F77_CONST_CHAR_ARG_DECL, - F77_CONST_CHAR_ARG_DECL, - const octave_idx_type&, const octave_idx_type&, float*, - const octave_idx_type&, float*, float*, - const octave_idx_type&, float*, const octave_idx_type&, - float*, 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&, float*, + const octave_idx_type&, float*, float*, + const octave_idx_type&, float*, const octave_idx_type&, + float*, const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } FloatMatrix @@ -49,7 +49,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("FloatSVD: U not computed because type == SVD::sigma_only"); + ("FloatSVD: U not computed because type == SVD::sigma_only"); return FloatMatrix (); } else @@ -62,7 +62,7 @@ if (type_computed == SVD::sigma_only) { (*current_liboctave_error_handler) - ("FloatSVD: V not computed because type == SVD::sigma_only"); + ("FloatSVD: V not computed because type == SVD::sigma_only"); return FloatMatrix (); } else @@ -141,21 +141,21 @@ octave_idx_type m1 = std::max (m, one), nrow_vt1 = std::max (nrow_vt, one); F77_XFCN (sgesvd, SGESVD, (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, 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, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); F77_XFCN (sgesvd, SGESVD, (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, 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, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (! (jobv == 'N' || jobv == 'O')) right_sm = right_sm.transpose ();
--- a/liboctave/idx-vector.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/idx-vector.cc Thu Feb 11 12:23:32 2010 -0500 @@ -380,7 +380,7 @@ octave_idx_type k = 0; for (octave_idx_type i = 0; i < ntot; i++) - if (bnda.xelem (i)) d[k++] = i; + if (bnda.xelem (i)) d[k++] = i; data = d; @@ -397,7 +397,7 @@ dim_vector dv = bnda.dims (); orig_dims = ((dv.length () == 2 && dv(0) == 1) - ? dim_vector (1, len) : orig_dims = dim_vector (len, 1)); + ? dim_vector (1, len) : orig_dims = dim_vector (len, 1)); if (len != 0) { @@ -870,7 +870,7 @@ bool idx_vector::is_cont_range (octave_idx_type n, - octave_idx_type& l, octave_idx_type& u) const + octave_idx_type& l, octave_idx_type& u) const { bool res = false; switch (rep->idx_class ())
--- a/liboctave/intNDArray.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/intNDArray.cc Thu Feb 11 12:23:32 2010 -0500 @@ -56,7 +56,7 @@ T val = this->elem (i); if (val != 0.0 && val != 1.0) - return true; + return true; } return false; @@ -88,8 +88,8 @@ template <class T> void intNDArray<T>::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); } @@ -97,7 +97,7 @@ template <class T> octave_idx_type intNDArray<T>::compute_index (Array<octave_idx_type>& ra_idx, - const dim_vector& dimensions) + const dim_vector& dimensions) { return ::compute_index (ra_idx, dimensions); } @@ -152,14 +152,14 @@ T tmp; for (octave_idx_type i = 0; i < nel; i++) - { - is >> tmp; + { + is >> tmp; - if (is) - a.elem (i) = tmp; - else - goto done; - } + if (is) + a.elem (i) = tmp; + else + goto done; + } } done:
--- a/liboctave/kpse.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/kpse.cc Thu Feb 11 12:23:32 2010 -0500 @@ -40,7 +40,7 @@ #endif #if defined (DOSISH) -#define MONOCASE_FILENAMES /* case-insensitive filename comparisons */ +#define MONOCASE_FILENAMES /* case-insensitive filename comparisons */ #endif extern "C" { @@ -56,9 +56,9 @@ #endif /* not WIN32 */ #ifdef __DJGPP__ -#include <fcntl.h> /* for long filenames' stuff */ -#include <dir.h> /* for `getdisk' */ -#include <io.h> /* for `setmode' */ +#include <fcntl.h> /* for long filenames' stuff */ +#include <dir.h> /* for `getdisk' */ +#include <io.h> /* for `setmode' */ #endif } @@ -173,28 +173,28 @@ /* Test if a bit is on. */ #define KPSE_DEBUG_P(bit) (kpathsea_debug & (1 << (bit))) -#define KPSE_DEBUG_STAT 0 /* stat calls */ -#define KPSE_DEBUG_HASH 1 /* hash lookups */ -#define KPSE_DEBUG_FOPEN 2 /* fopen/fclose calls */ -#define KPSE_DEBUG_PATHS 3 /* search path initializations */ -#define KPSE_DEBUG_EXPAND 4 /* path element expansion */ -#define KPSE_DEBUG_SEARCH 5 /* searches */ -#define KPSE_DEBUG_VARS 6 /* variable values */ +#define KPSE_DEBUG_STAT 0 /* stat calls */ +#define KPSE_DEBUG_HASH 1 /* hash lookups */ +#define KPSE_DEBUG_FOPEN 2 /* fopen/fclose calls */ +#define KPSE_DEBUG_PATHS 3 /* search path initializations */ +#define KPSE_DEBUG_EXPAND 4 /* path element expansion */ +#define KPSE_DEBUG_SEARCH 5 /* searches */ +#define KPSE_DEBUG_VARS 6 /* variable values */ #define KPSE_LAST_DEBUG KPSE_DEBUG_VARS /* A printf for the debugging. */ #define DEBUGF_START() do { fputs ("kdebug:", stderr) #define DEBUGF_END() fflush (stderr); } while (0) -#define DEBUGF(str) \ +#define DEBUGF(str) \ DEBUGF_START (); fputs (str, stderr); DEBUGF_END () -#define DEBUGF1(str, e1) \ +#define DEBUGF1(str, e1) \ DEBUGF_START (); fprintf (stderr, str, e1); DEBUGF_END () -#define DEBUGF2(str, e1, e2) \ +#define DEBUGF2(str, e1, e2) \ DEBUGF_START (); fprintf (stderr, str, e1, e2); DEBUGF_END () -#define DEBUGF3(str, e1, e2, e3) \ +#define DEBUGF3(str, e1, e2, e3) \ DEBUGF_START (); fprintf (stderr, str, e1, e2, e3); DEBUGF_END () -#define DEBUGF4(str, e1, e2, e3, e4) \ +#define DEBUGF4(str, e1, e2, e3, e4) \ DEBUGF_START (); fprintf (stderr, str, e1, e2, e3, e4); DEBUGF_END () #undef fopen @@ -307,10 +307,10 @@ static std::string kpse_expand (const std::string& s); static std::string kpse_expand_default (const std::string& path, - const std::string& dflt); + const std::string& dflt); static string_vector kpse_db_search (const std::string& name, - const std::string& path_elt, bool all); + const std::string& path_elt, bool all); #include <ctime> /* for `time' */ @@ -392,11 +392,11 @@ fputs (" (nil)\n", stderr); else { - int len = ret.length (); - for (int i = 0; i < len; i++) + int len = ret.length (); + for (int i = 0; i < len; i++) { putc (' ', stderr); - fputs (ret[i].c_str (), stderr); + fputs (ret[i].c_str (), stderr); } putc ('\n', stderr); } @@ -443,18 +443,18 @@ e = b + 1; if (e == len) - ; /* OK, we have found the last element. */ + ; /* OK, we have found the last element. */ else if (e > len) - b = e = std::string::npos; + b = e = std::string::npos; else - { - /* Find the next colon not enclosed by braces (or the end of - the path). */ - - int brace_level = 0; - while (e < len && ! (brace_level == 0 && kpse_is_env_sep (path[e]))) - e++; - } + { + /* Find the next colon not enclosed by braces (or the end of + the path). */ + + int brace_level = 0; + while (e < len && ! (brace_level == 0 && kpse_is_env_sep (path[e]))) + e++; + } } void next (void) @@ -463,12 +463,12 @@ /* Skip any consecutive colons. */ while (b < len && kpse_is_env_sep (path[b])) - b++; + b++; if (b >= len) - b = e = std::string::npos; + b = e = std::string::npos; else - set_end (); + set_end (); } // No assignment. @@ -490,7 +490,7 @@ #ifdef KPSE_DEBUG if (KPSE_DEBUG_P (KPSE_DEBUG_VARS)) DEBUGF2 ("variable: %s = %s\n", var.c_str (), - tmp.empty () ? "(nil)" : tmp.c_str ()); + tmp.empty () ? "(nil)" : tmp.c_str ()); #endif return ret; @@ -513,12 +513,12 @@ { if (IS_DIR_SEP (name[i]) || IS_DEVICE_SEP (name[i])) { - /* At a directory delimiter, reset component length. */ + /* At a directory delimiter, reset component length. */ c_len = 0; } else if (c_len > NAME_MAX) { - /* If past the max for a component, ignore this character. */ + /* If past the max for a component, ignore this character. */ continue; } @@ -543,7 +543,7 @@ { const char *t = fn.c_str (); return (GetFileAttributes (t) != 0xFFFFFFFF - && ! (GetFileAttributes (t) & FILE_ATTRIBUTE_DIRECTORY)); + && ! (GetFileAttributes (t) & FILE_ATTRIBUTE_DIRECTORY)); } #else static inline bool @@ -551,7 +551,7 @@ { const char *t = fn.c_str (); return (access (t, R_OK) == 0 - && stat (t, &(st)) == 0 && ! S_ISDIR (st.st_mode)); + && stat (t, &(st)) == 0 && ! S_ISDIR (st.st_mode)); } #endif @@ -578,13 +578,13 @@ ret = kpse_truncate_filename (name); /* Perhaps some other error will occur with the truncated name, - so let's call access again. */ + so let's call access again. */ if (! READABLE (ret, st)) - { - /* Failed. */ - ret = std::string (); - } + { + /* Failed. */ + ret = std::string (); + } #endif /* ENAMETOOLONG */ } @@ -592,10 +592,10 @@ { /* Some other error. */ if (errno == EACCES) - { - /* Maybe warn them if permissions are bad. */ - perror (name.c_str ()); - } + { + /* Maybe warn them if permissions are bad. */ + perror (name.c_str ()); + } ret = std::string (); } @@ -625,9 +625,9 @@ int explicit_relative = relative_ok && (len > 1 - && filename[0] == '.' - && (IS_DIR_SEP (filename[1]) - || (len > 2 && filename[1] == '.' && IS_DIR_SEP (filename[2])))); + && filename[0] == '.' + && (IS_DIR_SEP (filename[1]) + || (len > 2 && filename[1] == '.' && IS_DIR_SEP (filename[2])))); return absolute || explicit_relative; } @@ -658,33 +658,33 @@ std::string log_name = kpse_var_value ("TEXMFLOG"); if (! log_name.empty ()) - { - log_file = xfopen (log_name.c_str (), "a"); - - if (! log_file) - perror (log_name.c_str ()); - } + { + log_file = xfopen (log_name.c_str (), "a"); + + if (! log_file) + perror (log_name.c_str ()); + } } if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH) || log_file) { /* FILENAMES should never be null, but safety doesn't hurt. */ for (int e = 0; e < filenames.length () && ! filenames[e].empty (); e++) - { - std::string filename = filenames[e]; - - /* Only record absolute filenames, for privacy. */ - if (log_file && kpse_absolute_p (filename.c_str (), false)) - fprintf (log_file, "%lu %s\n", - static_cast<unsigned long> (time (0)), - filename.c_str ()); - - /* And show them online, if debugging. We've already started - the debugging line in `search', where this is called, so - just print the filename here, don't use DEBUGF. */ - if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - fputs (filename.c_str (), stderr); - } + { + std::string filename = filenames[e]; + + /* Only record absolute filenames, for privacy. */ + if (log_file && kpse_absolute_p (filename.c_str (), false)) + fprintf (log_file, "%lu %s\n", + static_cast<unsigned long> (time (0)), + filename.c_str ()); + + /* And show them online, if debugging. We've already started + the debugging line in `search', where this is called, so + just print the filename here, don't use DEBUGF. */ + if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) + fputs (filename.c_str (), stderr); + } } } @@ -700,7 +700,7 @@ static string_vector dir_list_search (str_llist_type *dirs, const std::string& name, - bool search_all) + bool search_all) { str_llist_elt_type *elt; string_vector ret; @@ -749,7 +749,7 @@ static string_vector path_search (const std::string& path, const std::string& name, - bool /* must_exist */, bool all) + bool /* must_exist */, bool all) { string_vector ret_list; bool done = false; @@ -762,65 +762,65 @@ bool allow_disk_search = true; if (elt.length () > 1 && elt[0] == '!' && elt[1] == '!') - { - /* Those magic leading chars in a path element means don't - search the disk for this elt. And move past the magic to - get to the name. */ - allow_disk_search = false; - elt = elt.substr (2); - } + { + /* Those magic leading chars in a path element means don't + search the disk for this elt. And move past the magic to + get to the name. */ + allow_disk_search = false; + elt = elt.substr (2); + } /* Do not touch the device if present */ if (NAME_BEGINS_WITH_DEVICE (elt)) - { - while (elt.length () > 3 - && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) - { - elt[2] = elt[1]; - elt[1] = elt[0]; - elt = elt.substr (1); - } - } + { + while (elt.length () > 3 + && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) + { + elt[2] = elt[1]; + elt[1] = elt[0]; + elt = elt.substr (1); + } + } else - { - /* We never want to search the whole disk. */ - while (elt.length () > 1 - && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) - elt = elt.substr (1); - } + { + /* We never want to search the whole disk. */ + while (elt.length () > 1 + && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) + elt = elt.substr (1); + } /* Try ls-R, unless we're searching for texmf.cnf. Our caller - (search), also tests first_search, and does the resetting. */ + (search), also tests first_search, and does the resetting. */ found = first_search - ? string_vector () : kpse_db_search (name, elt, all); + ? string_vector () : kpse_db_search (name, elt, all); /* Search the filesystem if (1) the path spec allows it, and either (2a) we are searching for texmf.cnf ; or (2b) no db exists; or (2c) no db's are relevant to this elt; or (3) MUST_EXIST && NAME was not in the db. - In (2*), `found' will be NULL. - In (3), `found' will be an empty list. */ + In (2*), `found' will be NULL. + In (3), `found' will be an empty list. */ if (allow_disk_search && found.empty ()) - { - str_llist_type *dirs = kpse_element_dirs (elt); - - if (dirs && *dirs) - found = dir_list_search (dirs, name, all); - } + { + str_llist_type *dirs = kpse_element_dirs (elt); + + if (dirs && *dirs) + found = dir_list_search (dirs, name, all); + } /* Did we find anything anywhere? */ if (! found.empty ()) - { - if (all) - ret_list.append (found); - else - { - ret_list.append (found[0]); - done = true; - } - } + { + if (all) + ret_list.append (found); + else + { + ret_list.append (found[0]); + done = true; + } + } } return ret_list; @@ -836,7 +836,7 @@ static string_vector search (const std::string& path, const std::string& original_name, - bool must_exist, bool all) + bool must_exist, bool all) { string_vector ret_list; bool absolute_p; @@ -865,15 +865,15 @@ else { /* Record the filenames we found, if desired. And wrap them in a - debugging line if we're doing that. */ + debugging line if we're doing that. */ if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - DEBUGF1 ("search (%s) =>", original_name.c_str ()); + DEBUGF1 ("search (%s) =>", original_name.c_str ()); log_search (ret_list); if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - putc ('\n', stderr); + putc ('\n', stderr); } return ret_list; @@ -901,7 +901,7 @@ static std::string kpse_path_search (const std::string& path, const std::string& name, - bool must_exist) + bool must_exist) { string_vector ret_list = search (path, name, must_exist, false); @@ -926,7 +926,7 @@ static string_vector path_find_first_of (const std::string& path, const string_vector& names, - bool /* must_exist */, bool all) + bool /* must_exist */, bool all) { string_vector ret_list; bool done = false; @@ -941,92 +941,92 @@ bool allow_disk_search = true; if (elt.length () > 1 && elt[0] == '!' && elt[1] == '!') - { - /* Those magic leading chars in a path element means don't - search the disk for this elt. And move past the magic to - get to the name. */ - - allow_disk_search = false; - elt = elt.substr (2); - } + { + /* Those magic leading chars in a path element means don't + search the disk for this elt. And move past the magic to + get to the name. */ + + allow_disk_search = false; + elt = elt.substr (2); + } /* Do not touch the device if present */ if (NAME_BEGINS_WITH_DEVICE (elt)) - { - while (elt.length () > 3 - && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) - { - elt[2] = elt[1]; - elt[1] = elt[0]; - elt = elt.substr (1); - } - } + { + while (elt.length () > 3 + && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) + { + elt[2] = elt[1]; + elt[1] = elt[0]; + elt = elt.substr (1); + } + } else - { - /* We never want to search the whole disk. */ - while (elt.length () > 1 - && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) - elt = elt.substr (1); - } + { + /* We never want to search the whole disk. */ + while (elt.length () > 1 + && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) + elt = elt.substr (1); + } /* We have to search one directory at a time. */ dirs = kpse_element_dirs (elt); for (dirs_elt = *dirs; dirs_elt; dirs_elt = STR_LLIST_NEXT (*dirs_elt)) - { - const std::string dir = STR_LLIST (*dirs_elt); - - int len = names.length (); - for (int i = 0; i < len && !done; i++) - { - std::string name = names[i]; - - /* Try ls-R, unless we're searching for texmf.cnf. Our caller - (find_first_of), also tests first_search, and does the - resetting. */ - found = first_search - ? string_vector () : kpse_db_search (name, dir.c_str (), all); - - /* Search the filesystem if (1) the path spec allows it, - and either - - (2a) we are searching for texmf.cnf ; or - (2b) no db exists; or - (2c) no db's are relevant to this elt; or - (3) MUST_EXIST && NAME was not in the db. - - In (2*), `found' will be NULL. - In (3), `found' will be an empty list. */ - - if (allow_disk_search && found.empty ()) - { - static str_llist_type *tmp = 0; - - if (! tmp) - { - tmp = new str_llist_type; - *tmp = 0; - str_llist_add (tmp, ""); - } - - STR_LLIST (*(*tmp)) = dir; - - found = dir_list_search (tmp, name, all); - } - - /* Did we find anything anywhere? */ - if (! found.empty ()) - { - if (all) - ret_list.append (found); - else - { - ret_list.append (found[0]); - done = true; - } - } - } - } + { + const std::string dir = STR_LLIST (*dirs_elt); + + int len = names.length (); + for (int i = 0; i < len && !done; i++) + { + std::string name = names[i]; + + /* Try ls-R, unless we're searching for texmf.cnf. Our caller + (find_first_of), also tests first_search, and does the + resetting. */ + found = first_search + ? string_vector () : kpse_db_search (name, dir.c_str (), all); + + /* Search the filesystem if (1) the path spec allows it, + and either + + (2a) we are searching for texmf.cnf ; or + (2b) no db exists; or + (2c) no db's are relevant to this elt; or + (3) MUST_EXIST && NAME was not in the db. + + In (2*), `found' will be NULL. + In (3), `found' will be an empty list. */ + + if (allow_disk_search && found.empty ()) + { + static str_llist_type *tmp = 0; + + if (! tmp) + { + tmp = new str_llist_type; + *tmp = 0; + str_llist_add (tmp, ""); + } + + STR_LLIST (*(*tmp)) = dir; + + found = dir_list_search (tmp, name, all); + } + + /* Did we find anything anywhere? */ + if (! found.empty ()) + { + if (all) + ret_list.append (found); + else + { + ret_list.append (found[0]); + done = true; + } + } + } + } } return ret_list; @@ -1034,7 +1034,7 @@ static string_vector find_first_of (const std::string& path, const string_vector& names, - bool must_exist, bool all) + bool must_exist, bool all) { string_vector ret_list; @@ -1045,15 +1045,15 @@ int len = names.length (); for (int i = 0; i < len; i++) - { - if (i == 0) - fputs (names[i].c_str (), stderr); - else - fprintf (stderr, ", %s", names[i].c_str ()); - } + { + if (i == 0) + fputs (names[i].c_str (), stderr); + else + fprintf (stderr, ", %s", names[i].c_str ()); + } fprintf (stderr, "), path=%s, must_exist=%d).\n", - path.c_str (), must_exist); + path.c_str (), must_exist); } for (int i = 0; i < names.length (); i++) @@ -1061,16 +1061,16 @@ std::string name = names[i]; if (kpse_absolute_p (name, true)) - { - /* If the name is absolute or explicitly relative, no need - to consider PATH at all. If we find something, then we - are done. */ - - ret_list = absolute_search (name); - - if (! ret_list.empty ()) - return ret_list; - } + { + /* If the name is absolute or explicitly relative, no need + to consider PATH at all. If we find something, then we + are done. */ + + ret_list = absolute_search (name); + + if (! ret_list.empty ()) + return ret_list; + } } /* Find the file. */ @@ -1085,28 +1085,28 @@ else { /* Record the filenames we found, if desired. And wrap them in a - debugging line if we're doing that. */ + debugging line if we're doing that. */ if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - { - fputs ("find_first_of (", stderr); - - int len = names.length (); - - for (int i = 0; i < len; i++) - { - if (i == 0) - fputs (names[i].c_str (), stderr); - else - fprintf (stderr, ", %s", names[i].c_str ()); - } - fputs (") =>", stderr); - } + { + fputs ("find_first_of (", stderr); + + int len = names.length (); + + for (int i = 0; i < len; i++) + { + if (i == 0) + fputs (names[i].c_str (), stderr); + else + fprintf (stderr, ", %s", names[i].c_str ()); + } + fputs (") =>", stderr); + } log_search (ret_list); if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - putc ('\n', stderr); + putc ('\n', stderr); } return ret_list; @@ -1120,7 +1120,7 @@ static std::string kpse_path_find_first_of (const std::string& path, const string_vector& names, - bool must_exist) + bool must_exist) { string_vector ret_list = find_first_of (path, names, must_exist, false); @@ -1136,7 +1136,7 @@ static string_vector kpse_all_path_find_first_of (const std::string& path, - const string_vector& names) + const string_vector& names) { return find_first_of (path, names, true, true); } @@ -1161,18 +1161,18 @@ expansion = name; /* If a bare tilde, return the home directory or `.'. (Very - unlikely that the directory name will do anyone any good, but - ... */ + unlikely that the directory name will do anyone any good, but + ... */ } else if (name.length () == 1) { expansion = octave_env::getenv ("HOME"); if (expansion.empty ()) - expansion = "."; + expansion = "."; /* If `~/', remove any trailing / or replace leading // in $HOME. - Should really check for doubled intermediate slashes, too. */ + Should really check for doubled intermediate slashes, too. */ } else if (IS_DIR_SEP (name[1])) { @@ -1180,22 +1180,22 @@ std::string home = octave_env::getenv ("HOME"); if (home.empty ()) - home = "."; + home = "."; size_t home_len = home.length (); /* handle leading // */ if (home_len > 1 && IS_DIR_SEP (home[0]) && IS_DIR_SEP (home[1])) - home = home.substr (1); + home = home.substr (1); /* omit / after ~ */ if (IS_DIR_SEP (home[home_len - 1])) - c++; + c++; expansion = home + name.substr (c); /* If `~user' or `~user/', look up user in the passwd database (but - OS/2 doesn't have this concept. */ + OS/2 doesn't have this concept. */ } else #ifdef HAVE_PWD_H @@ -1216,7 +1216,7 @@ std::string home = p ? p.dir () : std::string ("."); if (home.empty ()) - home = "."; + home = "."; /* handle leading // */ if (home.length () > 1 && IS_DIR_SEP (home[0]) && IS_DIR_SEP (home[1])) @@ -1268,19 +1268,19 @@ std::string elt = *pi; /* We assume that the !! magic is only used on absolute components. - Single "." get special treatment, as does "./" or its equivalent. */ + Single "." get special treatment, as does "./" or its equivalent. */ size_t elt_len = elt.length (); if (kpse_absolute_p (elt, false) - || (elt_len > 1 && elt[0] == '!' && elt[1] == '!')) - ret += elt + ENV_SEP_STRING; + || (elt_len > 1 && elt[0] == '!' && elt[1] == '!')) + ret += elt + ENV_SEP_STRING; else if (elt_len == 1 && elt[0] == '.') - ret += kpse_dot + ENV_SEP_STRING; + ret += kpse_dot + ENV_SEP_STRING; else if (elt_len > 1 && elt[0] == '.' && IS_DIR_SEP (elt[1])) - ret += kpse_dot + elt.substr (1) + ENV_SEP_STRING; + ret += kpse_dot + elt.substr (1) + ENV_SEP_STRING; else - ret += kpse_dot + DIR_SEP_STRING + elt + ENV_SEP_STRING; + ret += kpse_dot + DIR_SEP_STRING + elt + ENV_SEP_STRING; } int len = ret.length (); @@ -1308,13 +1308,13 @@ std::string x = kpse_expand (expansions[i]); if (x != expansions[i]) - { - /* If we did any expansions, do brace expansion again. Since - recursive variable definitions are not allowed, this recursion - must terminate. (In practice, it's unlikely there will ever be - more than one level of recursion.) */ - x = kpse_brace_expand_element (x); - } + { + /* If we did any expansions, do brace expansion again. Since + recursive variable definitions are not allowed, this recursion + must terminate. (In practice, it's unlikely there will ever be + more than one level of recursion.) */ + x = kpse_brace_expand_element (x); + } ret += x + ENV_SEP_STRING; } @@ -1387,55 +1387,55 @@ /* Skip and ignore magic leading chars. */ if (elt.length () > 1 && elt[0] == '!' && elt[1] == '!') - elt = elt.substr (2); + elt = elt.substr (2); /* Do not touch the device if present */ if (NAME_BEGINS_WITH_DEVICE (elt)) - { - while (elt.length () > 3 - && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) - { - elt[2] = elt[1]; - elt[1] = elt[0]; - elt = elt.substr (1); - } - } + { + while (elt.length () > 3 + && IS_DIR_SEP (elt[2]) && IS_DIR_SEP (elt[3])) + { + elt[2] = elt[1]; + elt[1] = elt[0]; + elt = elt.substr (1); + } + } else - { - /* We never want to search the whole disk. */ - while (elt.length () > 1 - && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) - elt = elt.substr (1); - } + { + /* We never want to search the whole disk. */ + while (elt.length () > 1 + && IS_DIR_SEP (elt[0]) && IS_DIR_SEP (elt[1])) + elt = elt.substr (1); + } /* Search the disk for all dirs in the component specified. - Be faster to check the database, but this is more reliable. */ + Be faster to check the database, but this is more reliable. */ dirs = kpse_element_dirs (elt); if (dirs && *dirs) - { - str_llist_elt_type *dir; - - for (dir = *dirs; dir; dir = STR_LLIST_NEXT (*dir)) - { - const std::string thedir = STR_LLIST (*dir); - unsigned dirlen = thedir.length (); - - ret += thedir; - len += dirlen; - - /* Retain trailing slash if that's the root directory. */ - if (dirlen == 1 - || (dirlen == 3 && NAME_BEGINS_WITH_DEVICE (thedir) - && IS_DIR_SEP (thedir[2]))) - { - ret += ENV_SEP_STRING; - len++; - } - - ret[len-1] = ENV_SEP; - } - } + { + str_llist_elt_type *dir; + + for (dir = *dirs; dir; dir = STR_LLIST_NEXT (*dir)) + { + const std::string thedir = STR_LLIST (*dir); + unsigned dirlen = thedir.length (); + + ret += thedir; + len += dirlen; + + /* Retain trailing slash if that's the root directory. */ + if (dirlen == 1 + || (dirlen == 3 && NAME_BEGINS_WITH_DEVICE (thedir) + && IS_DIR_SEP (thedir[2]))) + { + ret += ENV_SEP_STRING; + len++; + } + + ret[len-1] = ENV_SEP; + } + } } if (len > 0) @@ -1498,8 +1498,8 @@ int k = 0; for (int i = 0; i < len2; i++) - for (int j = 0; j < len1; j++) - result[k++] = arr1[j] + arr2[i]; + for (int j = 0; j < len1; j++) + result[k++] = arr1[j] + arr2[i]; } return result; @@ -1528,20 +1528,20 @@ /* What if there isn't a matching close brace? */ if (! c) - { - (*current_liboctave_warning_handler) - ("%s: Unmatched {", text.c_str ()); - - result = string_vector (text); - } + { + (*current_liboctave_warning_handler) + ("%s: Unmatched {", text.c_str ()); + + result = string_vector (text); + } else - { - std::string amble = text.substr (start, i-start); - result = array_concat (result, expand_amble (amble)); - - std::string postamble = text.substr (i+1); - result = array_concat (result, brace_expand (postamble)); - } + { + std::string amble = text.substr (start, i-start); + result = array_concat (result, expand_amble (amble)); + + std::string postamble = text.substr (i+1); + result = array_concat (result, brace_expand (postamble)); + } } return result; @@ -1577,9 +1577,9 @@ string_vector partial = brace_expand (tem); if (result.empty ()) - result = partial; + result = partial; else - result.append (partial); + result.append (partial); } return result; @@ -1603,13 +1603,13 @@ c = text[i]; if (pass_next) - { - pass_next = 0; - continue; - } + { + pass_next = 0; + continue; + } /* A backslash escapes the next character. This allows backslash to - escape the quote character in a double-quoted string. */ + escape the quote character in a double-quoted string. */ if (c == '\\' && (quoted == 0 || quoted == '"' || quoted == '`')) { pass_next = 1; @@ -1617,38 +1617,38 @@ } if (quoted) - { - if (c == quoted) - quoted = 0; - continue; - } + { + if (c == quoted) + quoted = 0; + continue; + } if (c == '"' || c == '\'' || c == '`') - { - quoted = c; - continue; - } + { + quoted = c; + continue; + } if (c == satisfy && !level && !quoted) - { - /* We ignore an open brace surrounded by whitespace, and also - an open brace followed immediately by a close brace, that - was preceded with whitespace. */ - if (c == '{' && - ((i == 0 || brace_whitespace (text[i-1])) && - (i+1 < text_len && - (brace_whitespace (text[i+1]) || text[i+1] == '}')))) - continue; - /* If this is being compiled as part of bash, ignore the `{' - in a `${}' construct */ - if ((c != '{') || i == 0 || (text[i-1] != '$')) - break; - } + { + /* We ignore an open brace surrounded by whitespace, and also + an open brace followed immediately by a close brace, that + was preceded with whitespace. */ + if (c == '{' && + ((i == 0 || brace_whitespace (text[i-1])) && + (i+1 < text_len && + (brace_whitespace (text[i+1]) || text[i+1] == '}')))) + continue; + /* If this is being compiled as part of bash, ignore the `{' + in a `${}' construct */ + if ((c != '{') || i == 0 || (text[i-1] != '$')) + break; + } if (c == '{') - level++; + level++; else if (c == '}' && level) - level--; + level--; } indx = i; @@ -1664,15 +1664,15 @@ struct kpse_format_info_type { - std::string type; /* Human-readable description. */ - std::string path; /* The search path to use. */ - std::string raw_path; /* Pre-$~ (but post-default) expansion. */ + std::string type; /* Human-readable description. */ + std::string path; /* The search path to use. */ + std::string raw_path; /* Pre-$~ (but post-default) expansion. */ std::string path_source; /* Where the path started from. */ std::string override_path; /* From client environment variable. */ std::string client_path; /* E.g., from dvips's config.ps. */ - std::string cnf_path; /* From texmf.cnf. */ + std::string cnf_path; /* From texmf.cnf. */ std::string default_path; /* If all else fails. */ - string_vector suffix; /* For kpse_find_file to check for/append. */ + string_vector suffix; /* For kpse_find_file to check for/append. */ }; /* The sole variable of that type, indexed by `kpse_file_format_type'. @@ -1686,9 +1686,9 @@ { \ if (! try_path.empty ()) \ { \ - info.raw_path = try_path; \ + info.raw_path = try_path; \ info.path = kpse_expand_default (try_path, info.path); \ - info.path_source = source_string; \ + info.path_source = source_string; \ } \ } \ while (0) @@ -1715,39 +1715,39 @@ for (; *filename && *path_elt; filename++, path_elt++) { if (*filename == *path_elt) /* normal character match */ - ; + ; else if (IS_DIR_SEP (*path_elt) /* at // */ - && original_filename < filename && IS_DIR_SEP (path_elt[-1])) - { - while (IS_DIR_SEP (*path_elt)) - path_elt++; /* get past second and any subsequent /'s */ - - if (*path_elt == 0) - { - /* Trailing //, matches anything. We could make this - part of the other case, but it seems pointless to do - the extra work. */ - matched = true; - break; - } - else - { - /* Intermediate //, have to match rest of PATH_ELT. */ - for (; !matched && *filename; filename++) - { - /* Try matching at each possible character. */ - if (IS_DIR_SEP (filename[-1]) && *filename == *path_elt) - matched = match (filename, path_elt); - } - - /* Prevent filename++ when *filename='\0'. */ - break; - } - } + && original_filename < filename && IS_DIR_SEP (path_elt[-1])) + { + while (IS_DIR_SEP (*path_elt)) + path_elt++; /* get past second and any subsequent /'s */ + + if (*path_elt == 0) + { + /* Trailing //, matches anything. We could make this + part of the other case, but it seems pointless to do + the extra work. */ + matched = true; + break; + } + else + { + /* Intermediate //, have to match rest of PATH_ELT. */ + for (; !matched && *filename; filename++) + { + /* Try matching at each possible character. */ + if (IS_DIR_SEP (filename[-1]) && *filename == *path_elt) + matched = match (filename, path_elt); + } + + /* Prevent filename++ when *filename='\0'. */ + break; + } + } else - /* normal character nonmatch, quit */ - break; + /* normal character nonmatch, quit */ + break; } /* If we've reached the end of PATH_ELT, check that we're at the last @@ -1755,18 +1755,18 @@ if (! matched && *path_elt == 0) { /* Probably PATH_ELT ended with `vf' or some such, and FILENAME - ends with `vf/ptmr.vf'. In that case, we'll be at a - directory separator. On the other hand, if PATH_ELT ended - with a / (as in `vf/'), FILENAME being the same `vf/ptmr.vf', - we'll be at the `p'. Upshot: if we're at a dir separator in - FILENAME, skip it. But if not, that's ok, as long as there - are no more dir separators. */ + ends with `vf/ptmr.vf'. In that case, we'll be at a + directory separator. On the other hand, if PATH_ELT ended + with a / (as in `vf/'), FILENAME being the same `vf/ptmr.vf', + we'll be at the `p'. Upshot: if we're at a dir separator in + FILENAME, skip it. But if not, that's ok, as long as there + are no more dir separators. */ if (IS_DIR_SEP (*filename)) - filename++; + filename++; while (*filename && !IS_DIR_SEP (*filename)) - filename++; + filename++; matched = *filename == 0; } @@ -1799,12 +1799,12 @@ i++; /* If we've matched the entire db directory, it's good. */ if (i == db_dir_len) - found = true; + found = true; /* If we've reached the end of PATH_ELT, but not the end of the db directory, it's no good. */ else if (i == path_elt_len) - break; + break; } return found; @@ -1820,7 +1820,7 @@ static string_vector kpse_db_search (const std::string& name_arg, - const std::string& orig_path_elt, bool all) + const std::string& orig_path_elt, bool all) { bool done; string_vector ret; @@ -1882,59 +1882,59 @@ string_vector db_dirs = hash_lookup (db, atry); /* For each filename found, see if it matches the path element. For - example, if we have .../cx/cmr10.300pk and .../ricoh/cmr10.300pk, - and the path looks like .../cx, we don't want the ricoh file. */ + example, if we have .../cx/cmr10.300pk and .../ricoh/cmr10.300pk, + and the path looks like .../cx, we don't want the ricoh file. */ int db_dirs_len = db_dirs.length (); for (int j = 0; j < db_dirs_len && !done; j++) - { - std::string db_file = db_dirs[j] + atry; - bool matched = match (db_file, path_elt); + { + std::string db_file = db_dirs[j] + atry; + bool matched = match (db_file, path_elt); #ifdef KPSE_DEBUG - if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) - DEBUGF3 ("db:match (%s,%s) = %d\n", db_file.c_str (), path_elt.c_str (), matched); + if (KPSE_DEBUG_P (KPSE_DEBUG_SEARCH)) + DEBUGF3 ("db:match (%s,%s) = %d\n", db_file.c_str (), path_elt.c_str (), matched); #endif - /* We got a hit in the database. Now see if the file actually - exists, possibly under an alias. */ - if (matched) - { - std::string found; - std::string tmp = kpse_readable_file (db_file); - if (! tmp.empty ()) - found = db_file; - else - { - /* The hit in the DB doesn't exist in disk. Now try - all its aliases. For example, suppose we have a - hierarchy on CD, thus `mf.bas', but ls-R contains - `mf.base'. Find it anyway. Could probably work - around this with aliases, but this is pretty easy - and shouldn't hurt. The upshot is that if one of - the aliases actually exists, we use that. */ - - int aliases_len = aliases.length (); - - for (int k = 1; k < aliases_len && found.empty (); k++) - { - std::string aatry = db_dirs[j] + aliases[k]; - tmp = kpse_readable_file (aatry); - if (! tmp.empty ()) - found = aatry; - } - } - - /* If we have a real file, add it to the list, maybe done. */ - if (! found.empty ()) - { - ret.append (found); - - if (! (all || found.empty ())) - done = true; - } - } - } + /* We got a hit in the database. Now see if the file actually + exists, possibly under an alias. */ + if (matched) + { + std::string found; + std::string tmp = kpse_readable_file (db_file); + if (! tmp.empty ()) + found = db_file; + else + { + /* The hit in the DB doesn't exist in disk. Now try + all its aliases. For example, suppose we have a + hierarchy on CD, thus `mf.bas', but ls-R contains + `mf.base'. Find it anyway. Could probably work + around this with aliases, but this is pretty easy + and shouldn't hurt. The upshot is that if one of + the aliases actually exists, we use that. */ + + int aliases_len = aliases.length (); + + for (int k = 1; k < aliases_len && found.empty (); k++) + { + std::string aatry = db_dirs[j] + aliases[k]; + tmp = kpse_readable_file (aatry); + if (! tmp.empty ()) + found = aatry; + } + } + + /* If we have a real file, add it to the list, maybe done. */ + if (! found.empty ()) + { + ret.append (found); + + if (! (all || found.empty ())) + done = true; + } + } + } } return ret; @@ -1982,15 +1982,15 @@ for (size_t i = 0; i < path_len; i++) { if (i + 1 < path_len - && IS_ENV_SEP (path[i]) && IS_ENV_SEP (path[i+1])) + && IS_ENV_SEP (path[i]) && IS_ENV_SEP (path[i+1])) { - /* We have a doubled colon. */ + /* We have a doubled colon. */ /* Copy stuff up to and including the first colon. */ /* Copy in FALLBACK, and then the rest of PATH. */ - expansion = path.substr (0, i+1) + fallback + path.substr (i+1); - - break; + expansion = path.substr (0, i+1) + fallback + path.substr (i+1); + + break; } } } @@ -2137,7 +2137,7 @@ struct stat stats; ret = stat (fn.c_str (), &stats) == 0 && S_ISDIR (stats.st_mode) - ? stats.st_nlink : static_cast<unsigned> (-1); + ? stats.st_nlink : static_cast<unsigned> (-1); link_table[fn] = ret; @@ -2154,7 +2154,7 @@ static void do_subdir (str_llist_type *str_list_ptr, const std::string& elt, - unsigned elt_length, const std::string& post) + unsigned elt_length, const std::string& post) { #ifdef WIN32 WIN32_FIND_DATA find_file_data; @@ -2185,8 +2185,8 @@ else { /* If we do have something to match, see if it exists. For - example, POST might be `pk/ljfour', and they might have a - directory `$TEXMF/fonts/pk/ljfour' that we should find. */ + example, POST might be `pk/ljfour', and they might have a + directory `$TEXMF/fonts/pk/ljfour' that we should find. */ name += post; expand_elt (str_list_ptr, name, elt_length); name.resize (elt_length); @@ -2197,20 +2197,20 @@ while (proceed) { if (find_file_data.cFileName[0] != '.') - { - /* Construct the potential subdirectory name. */ - name += find_file_data.cFileName; - - if (find_file_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - { - /* It's a directory, so append the separator. */ - name += DIR_SEP_STRING; - unsigned potential_len = name.length (); - - do_subdir (str_list_ptr, name, potential_len, post); - } - name.resize (elt_length); - } + { + /* Construct the potential subdirectory name. */ + name += find_file_data.cFileName; + + if (find_file_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) + { + /* It's a directory, so append the separator. */ + name += DIR_SEP_STRING; + unsigned potential_len = name.length (); + + do_subdir (str_list_ptr, name, potential_len, post); + } + name.resize (elt_length); + } proceed = FindNextFile (hnd, &find_file_data); } @@ -2298,7 +2298,7 @@ static void expand_elt (str_llist_type *str_list_ptr, const std::string& elt, - unsigned /* start */) + unsigned /* start */) { #if 0 // We don't want magic constructs. @@ -2315,21 +2315,21 @@ /* If two or more consecutive /'s, find subdirectories. */ if (++dir < elt_len && IS_DIR_SEP (elt[dir])) { - size_t i = dir; - while (i < elt_len && IS_DIR_SEP (elt[i])) - i++; - - std::string post = elt.substr (i); + size_t i = dir; + while (i < elt_len && IS_DIR_SEP (elt[i])) + i++; + + std::string post = elt.substr (i); do_subdir (str_list_ptr, elt, dir, post); - return; + return; } /* No special stuff at this slash. Keep going. */ } else - dir++; + dir++; } #endif @@ -2421,7 +2421,7 @@ if (KPSE_DEBUG_P (KPSE_DEBUG_FOPEN)) DEBUGF3 ("fopen (%s, %s) => 0x%lx\n", filename, mode, - reinterpret_cast<unsigned long> (ret)); + reinterpret_cast<unsigned long> (ret)); return ret; } @@ -2537,8 +2537,8 @@ if (expanding_p (var)) { (*current_liboctave_warning_handler) - ("kpathsea: variable `%s' references itself (eventually)", - var.c_str ()); + ("kpathsea: variable `%s' references itself (eventually)", + var.c_str ()); } else { @@ -2546,12 +2546,12 @@ std::string value = octave_env::getenv (var); if (! value.empty ()) - { - expanding (var, true); - std::string tmp = kpse_var_expand (value); - expanding (var, false); - expansion += tmp; - } + { + expanding (var, true); + std::string tmp = kpse_var_expand (value); + expanding (var, false); + expansion += tmp; + } } } @@ -2584,58 +2584,58 @@ for (size_t i = 0; i < src_len; i++) { if (IS_VAR_START (src[i])) - { - i++; - - /* Three cases: `$VAR', `${VAR}', `$<anything-else>'. */ - if (IS_VAR_CHAR (src[i])) - { - /* $V: collect name constituents, then expand. */ - size_t var_end = i; - - do - { - var_end++; - } - while (IS_VAR_CHAR (src[var_end])); - - var_end--; /* had to go one past */ - expand (expansion, src.substr (i, var_end - i + 1)); - i = var_end; - - } - else if (IS_VAR_BEGIN_DELIMITER (src[i])) - { - /* ${: scan ahead for matching delimiter, then expand. */ - size_t var_end = ++i; - - while (var_end < src_len && !IS_VAR_END_DELIMITER (src[var_end])) - var_end++; - - if (var_end == src_len) - { - (*current_liboctave_warning_handler) - ("%s: No matching } for ${", src.c_str ()); - i = var_end - 1; /* will incr to eos at top of loop */ - } - else - { - expand (expansion, src.substr (i, var_end - i)); - i = var_end; /* will incr past } at top of loop*/ - } - } - else - { - /* $<something-else>: error. */ - (*current_liboctave_warning_handler) - ("%s: Unrecognized variable construct `$%c'", - src.c_str (), src[i]); - - /* Just ignore those chars and keep going. */ - } - } + { + i++; + + /* Three cases: `$VAR', `${VAR}', `$<anything-else>'. */ + if (IS_VAR_CHAR (src[i])) + { + /* $V: collect name constituents, then expand. */ + size_t var_end = i; + + do + { + var_end++; + } + while (IS_VAR_CHAR (src[var_end])); + + var_end--; /* had to go one past */ + expand (expansion, src.substr (i, var_end - i + 1)); + i = var_end; + + } + else if (IS_VAR_BEGIN_DELIMITER (src[i])) + { + /* ${: scan ahead for matching delimiter, then expand. */ + size_t var_end = ++i; + + while (var_end < src_len && !IS_VAR_END_DELIMITER (src[var_end])) + var_end++; + + if (var_end == src_len) + { + (*current_liboctave_warning_handler) + ("%s: No matching } for ${", src.c_str ()); + i = var_end - 1; /* will incr to eos at top of loop */ + } + else + { + expand (expansion, src.substr (i, var_end - i)); + i = var_end; /* will incr past } at top of loop*/ + } + } + else + { + /* $<something-else>: error. */ + (*current_liboctave_warning_handler) + ("%s: Unrecognized variable construct `$%c'", + src.c_str (), src[i]); + + /* Just ignore those chars and keep going. */ + } + } else - expansion += src[i]; + expansion += src[i]; } return expansion;
--- a/liboctave/lo-ieee.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/lo-ieee.cc Thu Feb 11 12:23:32 2010 -0500 @@ -69,89 +69,89 @@ case oct_mach_info::flt_fmt_ieee_big_endian: case oct_mach_info::flt_fmt_ieee_little_endian: { - // Don't optimize away tmp_inf / tmp_inf to generate octave_NaN. + // Don't optimize away tmp_inf / tmp_inf to generate octave_NaN. - volatile double tmp_inf; + volatile double tmp_inf; #if defined (SCO) - volatile double tmp = 1.0; - tmp_inf = 1.0 / (tmp - tmp); + volatile double tmp = 1.0; + tmp_inf = 1.0 / (tmp - tmp); #elif defined (__alpha__) && defined (__osf__) - extern unsigned int DINFINITY[2]; - tmp_inf = (*(X_CAST(double *, DINFINITY))); + extern unsigned int DINFINITY[2]; + tmp_inf = (*(X_CAST(double *, DINFINITY))); #else - double tmp = 1e+10; - tmp_inf = tmp; - for (;;) - { - tmp_inf *= 1e+10; - if (tmp_inf == tmp) - break; - tmp = tmp_inf; - } + double tmp = 1e+10; + tmp_inf = tmp; + for (;;) + { + tmp_inf *= 1e+10; + if (tmp_inf == tmp) + break; + tmp = tmp_inf; + } #endif #if defined (__alpha__) && defined (__osf__) - extern unsigned int DQNAN[2]; - octave_NaN = (*(X_CAST(double *, DQNAN))); + extern unsigned int DQNAN[2]; + octave_NaN = (*(X_CAST(double *, DQNAN))); #elif defined (__NetBSD__) - octave_NaN = nan (""); + octave_NaN = nan (""); #else - octave_NaN = tmp_inf / tmp_inf; + octave_NaN = tmp_inf / tmp_inf; // try to ensure that lo_ieee_sign gives false for a NaN. if (lo_ieee_signbit (octave_NaN)) octave_NaN = -octave_NaN; #endif - octave_Inf = tmp_inf; + octave_Inf = tmp_inf; - // This is patterned after code in R. + // This is patterned after code in R. - if (ff == oct_mach_info::flt_fmt_ieee_big_endian) - { - lo_ieee_hw = 0; - lo_ieee_lw = 1; - } - else - { - lo_ieee_hw = 1; - lo_ieee_lw = 0; - } + if (ff == oct_mach_info::flt_fmt_ieee_big_endian) + { + lo_ieee_hw = 0; + lo_ieee_lw = 1; + } + else + { + lo_ieee_hw = 1; + lo_ieee_lw = 0; + } - lo_ieee_double t; - t.word[lo_ieee_hw] = LO_IEEE_NA_HW; - t.word[lo_ieee_lw] = LO_IEEE_NA_LW; + lo_ieee_double t; + t.word[lo_ieee_hw] = LO_IEEE_NA_HW; + t.word[lo_ieee_lw] = LO_IEEE_NA_LW; - octave_NA = t.value; + octave_NA = t.value; - volatile float float_tmp_inf; + volatile float float_tmp_inf; #if defined (SCO) - volatile float float_tmp = 1.0; - float_tmp_inf = 1.0 / (float_tmp - float_tmp); + volatile float float_tmp = 1.0; + float_tmp_inf = 1.0 / (float_tmp - float_tmp); #else - float float_tmp = 1e+10; - float_tmp_inf = float_tmp; - for (;;) - { - float_tmp_inf *= 1e+10; - if (float_tmp_inf == float_tmp) - break; - float_tmp = float_tmp_inf; - } + float float_tmp = 1e+10; + float_tmp_inf = float_tmp; + for (;;) + { + float_tmp_inf *= 1e+10; + if (float_tmp_inf == float_tmp) + break; + float_tmp = float_tmp_inf; + } #endif #if defined (__NetBSD__) - octave_Float_NaN = nanf (""); + octave_Float_NaN = nanf (""); #else - octave_Float_NaN = float_tmp_inf / float_tmp_inf; + octave_Float_NaN = float_tmp_inf / float_tmp_inf; #endif - octave_Float_Inf = float_tmp_inf; + octave_Float_Inf = float_tmp_inf; - lo_ieee_float tf; - tf.word = LO_IEEE_NA_FLOAT; - octave_Float_NA = tf.value; + lo_ieee_float tf; + tf.word = LO_IEEE_NA_FLOAT; + octave_Float_NA = tf.value; } break; @@ -165,7 +165,7 @@ // floating point should be capable of removing this check and // the configure test. (*current_liboctave_error_handler) - ("lo_ieee_init: floating point format is not IEEE! Maybe DLAMCH is miscompiled, or you are using some strange system without IEEE floating point math?"); + ("lo_ieee_init: floating point format is not IEEE! Maybe DLAMCH is miscompiled, or you are using some strange system without IEEE floating point math?"); abort (); } }
--- a/liboctave/lo-mappers.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/lo-mappers.cc Thu Feb 11 12:23:32 2010 -0500 @@ -80,7 +80,7 @@ double y = floor (x); if ((x - y) >= 0.5) - y += 1.0; + y += 1.0; return y; } @@ -89,7 +89,7 @@ double y = ceil (x); if ((y - x) >= 0.5) - y -= 1.0; + y -= 1.0; return y; } @@ -384,7 +384,7 @@ float y = floor (x); if ((x - y) >= 0.5) - y += 1.0; + y += 1.0; return y; } @@ -393,7 +393,7 @@ float y = ceil (x); if ((y - x) >= 0.5) - y -= 1.0; + y -= 1.0; return y; }
--- a/liboctave/lo-specfun.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/lo-specfun.cc Thu Feb 11 12:23:32 2010 -0500 @@ -53,71 +53,71 @@ { F77_RET_T F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&, - const octave_idx_type&, const octave_idx_type&, double*, double*, - octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, double*, double*, + octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&, - const octave_idx_type&, const octave_idx_type&, double*, double*, - octave_idx_type&, double*, double*, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, double*, double*, + octave_idx_type&, double*, double*, octave_idx_type&); F77_RET_T F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&, - const octave_idx_type&, const octave_idx_type&, double*, double*, - octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, double*, double*, + octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&, - const octave_idx_type&, const octave_idx_type&, double*, double*, - octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, double*, double*, + octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&, - const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, - double*, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, + double*, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cbesj, cBESJ) (const FloatComplex&, const float&, - const octave_idx_type&, const octave_idx_type&, - FloatComplex*, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + FloatComplex*, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cbesy, CBESY) (const FloatComplex&, const float&, - const octave_idx_type&, const octave_idx_type&, - FloatComplex*, octave_idx_type&, - FloatComplex*, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + FloatComplex*, octave_idx_type&, + FloatComplex*, octave_idx_type&); F77_RET_T F77_FUNC (cbesi, CBESI) (const FloatComplex&, const float&, - const octave_idx_type&, const octave_idx_type&, - FloatComplex*, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + FloatComplex*, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cbesk, CBESK) (const FloatComplex&, const float&, - const octave_idx_type&, const octave_idx_type&, - FloatComplex*, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + FloatComplex*, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cbesh, CBESH) (const FloatComplex&, const float&, - const octave_idx_type&, const octave_idx_type&, - const octave_idx_type&, FloatComplex*, - octave_idx_type&, octave_idx_type&); + const octave_idx_type&, const octave_idx_type&, + const octave_idx_type&, FloatComplex*, + octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zairy, ZAIRY) (const double&, const double&, const octave_idx_type&, - const octave_idx_type&, double&, double&, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, double&, double&, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (cairy, CAIRY) (const float&, const float&, const octave_idx_type&, - const octave_idx_type&, float&, float&, octave_idx_type&, octave_idx_type&); + const octave_idx_type&, float&, float&, octave_idx_type&, octave_idx_type&); F77_RET_T F77_FUNC (zbiry, ZBIRY) (const double&, const double&, const octave_idx_type&, - const octave_idx_type&, double&, double&, octave_idx_type&); + const octave_idx_type&, double&, double&, octave_idx_type&); F77_RET_T F77_FUNC (cbiry, CBIRY) (const float&, const float&, const octave_idx_type&, - const octave_idx_type&, float&, float&, octave_idx_type&); + const octave_idx_type&, float&, float&, octave_idx_type&); F77_RET_T F77_FUNC (xdacosh, XDACOSH) (const double&, double&); @@ -151,11 +151,11 @@ F77_RET_T F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, - const double&, double&); + const double&, double&); F77_RET_T F77_FUNC (xbetai, XBETAI) (const float&, const float&, - const float&, float&); + const float&, float&); F77_RET_T F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); @@ -551,7 +551,7 @@ { double u = 2*r + r*r + i*i; retval = Complex (log1p (u / (1+sqrt (u+1))), - atan2 (1 + r, i)); + atan2 (1 + r, i)); } else retval = std::log (Complex(1) + x); @@ -594,7 +594,7 @@ { float u = 2*r + r*r + i*i; retval = FloatComplex (log1p (u / (1+sqrt (u+1))), - atan2 (1 + r, i)); + atan2 (1 + r, i)); } else retval = std::log (FloatComplex(1) + x); @@ -671,14 +671,14 @@ F77_FUNC (zbesj, ZBESJ) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); if (kode != 2) - { - double expz = exp (std::abs (zi)); - yr *= expz; - yi *= expz; - } + { + double expz = exp (std::abs (zi)); + yr *= expz; + yi *= expz; + } if (zi == 0.0 && zr >= 0.0) - yi = 0.0; + yi = 0.0; retval = bessel_return_value (Complex (yr, yi), ierr); } @@ -688,7 +688,7 @@ alpha = -alpha; Complex tmp = zbesj (z, alpha, kode, ierr); if ((static_cast <long> (alpha)) & 1) - tmp = - tmp; + tmp = - tmp; retval = bessel_return_value (tmp, ierr); } else @@ -698,13 +698,13 @@ Complex tmp = cos (M_PI * alpha) * zbesj (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - tmp -= sin (M_PI * alpha) * zbesy (z, alpha, kode, ierr); - - retval = bessel_return_value (tmp, ierr); - } + { + tmp -= sin (M_PI * alpha) * zbesy (z, alpha, kode, ierr); + + retval = bessel_return_value (tmp, ierr); + } else - retval = Complex (octave_NaN, octave_NaN); + retval = Complex (octave_NaN, octave_NaN); } return retval; @@ -730,25 +730,25 @@ ierr = 0; if (zr == 0.0 && zi == 0.0) - { - yr = -octave_Inf; - yi = 0.0; - } + { + yr = -octave_Inf; + yi = 0.0; + } else - { - F77_FUNC (zbesy, ZBESY) (zr, zi, alpha, 2, 1, &yr, &yi, nz, - &wr, &wi, ierr); - - if (kode != 2) - { - double expz = exp (std::abs (zi)); - yr *= expz; - yi *= expz; - } - - if (zi == 0.0 && zr >= 0.0) - yi = 0.0; - } + { + F77_FUNC (zbesy, ZBESY) (zr, zi, alpha, 2, 1, &yr, &yi, nz, + &wr, &wi, ierr); + + if (kode != 2) + { + double expz = exp (std::abs (zi)); + yr *= expz; + yi *= expz; + } + + if (zi == 0.0 && zr >= 0.0) + yi = 0.0; + } return bessel_return_value (Complex (yr, yi), ierr); } @@ -758,7 +758,7 @@ alpha = -alpha; Complex tmp = zbesj (z, alpha, kode, ierr); if ((static_cast <long> (alpha - 0.5)) & 1) - tmp = - tmp; + tmp = - tmp; retval = bessel_return_value (tmp, ierr); } else @@ -768,13 +768,13 @@ Complex tmp = cos (M_PI * alpha) * zbesy (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - tmp += sin (M_PI * alpha) * zbesj (z, alpha, kode, ierr); - - retval = bessel_return_value (tmp, ierr); - } + { + tmp += sin (M_PI * alpha) * zbesj (z, alpha, kode, ierr); + + retval = bessel_return_value (tmp, ierr); + } else - retval = Complex (octave_NaN, octave_NaN); + retval = Complex (octave_NaN, octave_NaN); } return retval; @@ -798,14 +798,14 @@ F77_FUNC (zbesi, ZBESI) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); if (kode != 2) - { - double expz = exp (std::abs (zr)); - yr *= expz; - yi *= expz; - } + { + double expz = exp (std::abs (zr)); + yr *= expz; + yi *= expz; + } if (zi == 0.0 && zr >= 0.0) - yi = 0.0; + yi = 0.0; retval = bessel_return_value (Complex (yr, yi), ierr); } @@ -816,22 +816,22 @@ Complex tmp = zbesi (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - Complex tmp2 = (2.0 / M_PI) * sin (M_PI * alpha) - * zbesk (z, alpha, kode, ierr); - - if (kode == 2) - { - // Compensate for different scaling factor of besk. - tmp2 *= exp(-z - std::abs(z.real())); - } - - tmp += tmp2; - - retval = bessel_return_value (tmp, ierr); - } + { + Complex tmp2 = (2.0 / M_PI) * sin (M_PI * alpha) + * zbesk (z, alpha, kode, ierr); + + if (kode == 2) + { + // Compensate for different scaling factor of besk. + tmp2 *= exp(-z - std::abs(z.real())); + } + + tmp += tmp2; + + retval = bessel_return_value (tmp, ierr); + } else - retval = Complex (octave_NaN, octave_NaN); + retval = Complex (octave_NaN, octave_NaN); } return retval; @@ -855,30 +855,30 @@ ierr = 0; if (zr == 0.0 && zi == 0.0) - { - yr = octave_Inf; - yi = 0.0; - } + { + yr = octave_Inf; + yi = 0.0; + } else - { - F77_FUNC (zbesk, ZBESK) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); - - if (kode != 2) - { - Complex expz = exp (-z); - - double rexpz = real (expz); - double iexpz = imag (expz); - - double tmp = yr*rexpz - yi*iexpz; - - yi = yr*iexpz + yi*rexpz; - yr = tmp; - } - - if (zi == 0.0 && zr >= 0.0) - yi = 0.0; - } + { + F77_FUNC (zbesk, ZBESK) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); + + if (kode != 2) + { + Complex expz = exp (-z); + + double rexpz = real (expz); + double iexpz = imag (expz); + + double tmp = yr*rexpz - yi*iexpz; + + yi = yr*iexpz + yi*rexpz; + yr = tmp; + } + + if (zi == 0.0 && zr >= 0.0) + yi = 0.0; + } retval = bessel_return_value (Complex (yr, yi), ierr); } @@ -910,17 +910,17 @@ F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 1, 1, &yr, &yi, nz, ierr); if (kode != 2) - { - Complex expz = exp (Complex (0.0, 1.0) * z); - - double rexpz = real (expz); - double iexpz = imag (expz); - - double tmp = yr*rexpz - yi*iexpz; - - yi = yr*iexpz + yi*rexpz; - yr = tmp; - } + { + Complex expz = exp (Complex (0.0, 1.0) * z); + + double rexpz = real (expz); + double iexpz = imag (expz); + + double tmp = yr*rexpz - yi*iexpz; + + yi = yr*iexpz + yi*rexpz; + yr = tmp; + } retval = bessel_return_value (Complex (yr, yi), ierr); } @@ -956,17 +956,17 @@ F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 2, 1, &yr, &yi, nz, ierr); if (kode != 2) - { - Complex expz = exp (-Complex (0.0, 1.0) * z); - - double rexpz = real (expz); - double iexpz = imag (expz); - - double tmp = yr*rexpz - yi*iexpz; - - yi = yr*iexpz + yi*rexpz; - yr = tmp; - } + { + Complex expz = exp (-Complex (0.0, 1.0) * z); + + double rexpz = real (expz); + double iexpz = imag (expz); + + double tmp = yr*rexpz - yi*iexpz; + + yi = yr*iexpz + yi*rexpz; + yr = tmp; + } retval = bessel_return_value (Complex (yr, yi), ierr); } @@ -988,7 +988,7 @@ static inline Complex do_bessel (dptr f, const char *, double alpha, const Complex& x, - bool scaled, octave_idx_type& ierr) + bool scaled, octave_idx_type& ierr) { Complex retval; @@ -999,7 +999,7 @@ static inline ComplexMatrix do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x, - bool scaled, Array2<octave_idx_type>& ierr) + bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = x.rows (); octave_idx_type nc = x.cols (); @@ -1017,7 +1017,7 @@ static inline ComplexMatrix do_bessel (dptr f, const char *, const Matrix& alpha, const Complex& x, - bool scaled, Array2<octave_idx_type>& ierr) + bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = alpha.rows (); octave_idx_type nc = alpha.cols (); @@ -1035,7 +1035,7 @@ static inline ComplexMatrix do_bessel (dptr f, const char *fn, const Matrix& alpha, - const ComplexMatrix& x, bool scaled, Array2<octave_idx_type>& ierr) + const ComplexMatrix& x, bool scaled, Array2<octave_idx_type>& ierr) { ComplexMatrix retval; @@ -1055,8 +1055,8 @@ ierr.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); } else (*current_liboctave_error_handler) @@ -1067,7 +1067,7 @@ static inline ComplexNDArray do_bessel (dptr f, const char *, double alpha, const ComplexNDArray& x, - bool scaled, Array<octave_idx_type>& ierr) + bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = x.dims (); octave_idx_type nel = dv.numel (); @@ -1083,7 +1083,7 @@ static inline ComplexNDArray do_bessel (dptr f, const char *, const NDArray& alpha, const Complex& x, - bool scaled, Array<octave_idx_type>& ierr) + bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = alpha.dims (); octave_idx_type nel = dv.numel (); @@ -1099,7 +1099,7 @@ static inline ComplexNDArray do_bessel (dptr f, const char *fn, const NDArray& alpha, - const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) + const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = x.dims (); ComplexNDArray retval; @@ -1112,7 +1112,7 @@ ierr.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); + retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); } else (*current_liboctave_error_handler) @@ -1123,7 +1123,7 @@ static inline ComplexMatrix do_bessel (dptr f, const char *, const RowVector& alpha, - const ComplexColumnVector& x, bool scaled, Array2<octave_idx_type>& ierr) + const ComplexColumnVector& x, bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = x.length (); octave_idx_type nc = alpha.length (); @@ -1149,7 +1149,7 @@ #define SM_BESSEL(name, fcn) \ ComplexMatrix \ name (double alpha, const ComplexMatrix& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1157,7 +1157,7 @@ #define MS_BESSEL(name, fcn) \ ComplexMatrix \ name (const Matrix& alpha, const Complex& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1165,7 +1165,7 @@ #define MM_BESSEL(name, fcn) \ ComplexMatrix \ name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1173,7 +1173,7 @@ #define SN_BESSEL(name, fcn) \ ComplexNDArray \ name (double alpha, const ComplexNDArray& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1181,7 +1181,7 @@ #define NS_BESSEL(name, fcn) \ ComplexNDArray \ name (const NDArray& alpha, const Complex& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1189,7 +1189,7 @@ #define NN_BESSEL(name, fcn) \ ComplexNDArray \ name (const NDArray& alpha, const ComplexNDArray& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1294,13 +1294,13 @@ F77_FUNC (cbesj, CBESJ) (z, alpha, 2, 1, &y, nz, ierr); if (kode != 2) - { - float expz = exp (std::abs (imag (z))); - y *= expz; - } + { + float expz = exp (std::abs (imag (z))); + y *= expz; + } if (imag (z) == 0.0 && real (z) >= 0.0) - y = FloatComplex (y.real (), 0.0); + y = FloatComplex (y.real (), 0.0); retval = bessel_return_value (y, ierr); } @@ -1310,7 +1310,7 @@ alpha = -alpha; FloatComplex tmp = cbesj (z, alpha, kode, ierr); if ((static_cast <long> (alpha)) & 1) - tmp = - tmp; + tmp = - tmp; retval = bessel_return_value (tmp, ierr); } else @@ -1320,13 +1320,13 @@ FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - tmp -= sinf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); - - retval = bessel_return_value (tmp, ierr); - } + { + tmp -= sinf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); + + retval = bessel_return_value (tmp, ierr); + } else - retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); + retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); } return retval; @@ -1348,22 +1348,22 @@ ierr = 0; if (real (z) == 0.0 && imag (z) == 0.0) - { - y = FloatComplex (-octave_Float_Inf, 0.0); - } + { + y = FloatComplex (-octave_Float_Inf, 0.0); + } else - { - F77_FUNC (cbesy, CBESY) (z, alpha, 2, 1, &y, nz, &w, ierr); - - if (kode != 2) - { - float expz = exp (std::abs (imag (z))); - y *= expz; - } - - if (imag (z) == 0.0 && real (z) >= 0.0) - y = FloatComplex (y.real (), 0.0); - } + { + F77_FUNC (cbesy, CBESY) (z, alpha, 2, 1, &y, nz, &w, ierr); + + if (kode != 2) + { + float expz = exp (std::abs (imag (z))); + y *= expz; + } + + if (imag (z) == 0.0 && real (z) >= 0.0) + y = FloatComplex (y.real (), 0.0); + } return bessel_return_value (y, ierr); } @@ -1373,7 +1373,7 @@ alpha = -alpha; FloatComplex tmp = cbesj (z, alpha, kode, ierr); if ((static_cast <long> (alpha - 0.5)) & 1) - tmp = - tmp; + tmp = - tmp; retval = bessel_return_value (tmp, ierr); } else @@ -1383,13 +1383,13 @@ FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - tmp += sinf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); - - retval = bessel_return_value (tmp, ierr); - } + { + tmp += sinf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); + + retval = bessel_return_value (tmp, ierr); + } else - retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); + retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); } return retval; @@ -1409,13 +1409,13 @@ F77_FUNC (cbesi, CBESI) (z, alpha, 2, 1, &y, nz, ierr); if (kode != 2) - { - float expz = exp (std::abs (real (z))); - y *= expz; - } + { + float expz = exp (std::abs (real (z))); + y *= expz; + } if (imag (z) == 0.0 && real (z) >= 0.0) - y = FloatComplex (y.real (), 0.0); + y = FloatComplex (y.real (), 0.0); retval = bessel_return_value (y, ierr); } @@ -1426,22 +1426,22 @@ FloatComplex tmp = cbesi (z, alpha, kode, ierr); if (ierr == 0 || ierr == 3) - { - FloatComplex tmp2 = static_cast<float> (2.0 / M_PI) * sinf (static_cast<float> (M_PI) * alpha) - * cbesk (z, alpha, kode, ierr); - - if (kode == 2) - { - // Compensate for different scaling factor of besk. - tmp2 *= exp(-z - std::abs(z.real())); - } - - tmp += tmp2; - - retval = bessel_return_value (tmp, ierr); - } + { + FloatComplex tmp2 = static_cast<float> (2.0 / M_PI) * sinf (static_cast<float> (M_PI) * alpha) + * cbesk (z, alpha, kode, ierr); + + if (kode == 2) + { + // Compensate for different scaling factor of besk. + tmp2 *= exp(-z - std::abs(z.real())); + } + + tmp += tmp2; + + retval = bessel_return_value (tmp, ierr); + } else - retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); + retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); } return retval; @@ -1461,29 +1461,29 @@ ierr = 0; if (real (z) == 0.0 && imag (z) == 0.0) - { - y = FloatComplex (octave_Float_Inf, 0.0); - } + { + y = FloatComplex (octave_Float_Inf, 0.0); + } else - { - F77_FUNC (cbesk, CBESK) (z, alpha, 2, 1, &y, nz, ierr); - - if (kode != 2) - { - FloatComplex expz = exp (-z); - - float rexpz = real (expz); - float iexpz = imag (expz); - - float tmp_r = real (y) * rexpz - imag (y) * iexpz; - float tmp_i = real (y) * iexpz + imag (y) * rexpz; - - y = FloatComplex (tmp_r, tmp_i); - } - - if (imag (z) == 0.0 && real (z) >= 0.0) - y = FloatComplex (y.real (), 0.0); - } + { + F77_FUNC (cbesk, CBESK) (z, alpha, 2, 1, &y, nz, ierr); + + if (kode != 2) + { + FloatComplex expz = exp (-z); + + float rexpz = real (expz); + float iexpz = imag (expz); + + float tmp_r = real (y) * rexpz - imag (y) * iexpz; + float tmp_i = real (y) * iexpz + imag (y) * rexpz; + + y = FloatComplex (tmp_r, tmp_i); + } + + if (imag (z) == 0.0 && real (z) >= 0.0) + y = FloatComplex (y.real (), 0.0); + } retval = bessel_return_value (y, ierr); } @@ -1511,17 +1511,17 @@ F77_FUNC (cbesh, CBESH) (z, alpha, 2, 1, 1, &y, nz, ierr); if (kode != 2) - { - FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z); - - float rexpz = real (expz); - float iexpz = imag (expz); - - float tmp_r = real (y) * rexpz - imag (y) * iexpz; - float tmp_i = real (y) * iexpz + imag (y) * rexpz; - - y = FloatComplex (tmp_r, tmp_i); - } + { + FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z); + + float rexpz = real (expz); + float iexpz = imag (expz); + + float tmp_r = real (y) * rexpz - imag (y) * iexpz; + float tmp_i = real (y) * iexpz + imag (y) * rexpz; + + y = FloatComplex (tmp_r, tmp_i); + } retval = bessel_return_value (y, ierr); } @@ -1553,17 +1553,17 @@ F77_FUNC (cbesh, CBESH) (z, alpha, 2, 2, 1, &y, nz, ierr); if (kode != 2) - { - FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z); - - float rexpz = real (expz); - float iexpz = imag (expz); - - float tmp_r = real (y) * rexpz - imag (y) * iexpz; - float tmp_i = real (y) * iexpz + imag (y) * rexpz; - - y = FloatComplex (tmp_r, tmp_i); - } + { + FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z); + + float rexpz = real (expz); + float iexpz = imag (expz); + + float tmp_r = real (y) * rexpz - imag (y) * iexpz; + float tmp_i = real (y) * iexpz + imag (y) * rexpz; + + y = FloatComplex (tmp_r, tmp_i); + } retval = bessel_return_value (y, ierr); } @@ -1585,7 +1585,7 @@ static inline FloatComplex do_bessel (fptr f, const char *, float alpha, const FloatComplex& x, - bool scaled, octave_idx_type& ierr) + bool scaled, octave_idx_type& ierr) { FloatComplex retval; @@ -1596,7 +1596,7 @@ static inline FloatComplexMatrix do_bessel (fptr f, const char *, float alpha, const FloatComplexMatrix& x, - bool scaled, Array2<octave_idx_type>& ierr) + bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = x.rows (); octave_idx_type nc = x.cols (); @@ -1614,7 +1614,7 @@ static inline FloatComplexMatrix do_bessel (fptr f, const char *, const FloatMatrix& alpha, const FloatComplex& x, - bool scaled, Array2<octave_idx_type>& ierr) + bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = alpha.rows (); octave_idx_type nc = alpha.cols (); @@ -1632,7 +1632,7 @@ static inline FloatComplexMatrix do_bessel (fptr f, const char *fn, const FloatMatrix& alpha, - const FloatComplexMatrix& x, bool scaled, Array2<octave_idx_type>& ierr) + const FloatComplexMatrix& x, bool scaled, Array2<octave_idx_type>& ierr) { FloatComplexMatrix retval; @@ -1652,8 +1652,8 @@ ierr.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); } else (*current_liboctave_error_handler) @@ -1664,7 +1664,7 @@ static inline FloatComplexNDArray do_bessel (fptr f, const char *, float alpha, const FloatComplexNDArray& x, - bool scaled, Array<octave_idx_type>& ierr) + bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = x.dims (); octave_idx_type nel = dv.numel (); @@ -1680,7 +1680,7 @@ static inline FloatComplexNDArray do_bessel (fptr f, const char *, const FloatNDArray& alpha, const FloatComplex& x, - bool scaled, Array<octave_idx_type>& ierr) + bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = alpha.dims (); octave_idx_type nel = dv.numel (); @@ -1696,7 +1696,7 @@ static inline FloatComplexNDArray do_bessel (fptr f, const char *fn, const FloatNDArray& alpha, - const FloatComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) + const FloatComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) { dim_vector dv = x.dims (); FloatComplexNDArray retval; @@ -1709,7 +1709,7 @@ ierr.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); + retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); } else (*current_liboctave_error_handler) @@ -1720,7 +1720,7 @@ static inline FloatComplexMatrix do_bessel (fptr f, const char *, const FloatRowVector& alpha, - const FloatComplexColumnVector& x, bool scaled, Array2<octave_idx_type>& ierr) + const FloatComplexColumnVector& x, bool scaled, Array2<octave_idx_type>& ierr) { octave_idx_type nr = x.length (); octave_idx_type nc = alpha.length (); @@ -1746,7 +1746,7 @@ #define SM_BESSEL(name, fcn) \ FloatComplexMatrix \ name (float alpha, const FloatComplexMatrix& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1754,7 +1754,7 @@ #define MS_BESSEL(name, fcn) \ FloatComplexMatrix \ name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1762,7 +1762,7 @@ #define MM_BESSEL(name, fcn) \ FloatComplexMatrix \ name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \ - Array2<octave_idx_type>& ierr) \ + Array2<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1770,7 +1770,7 @@ #define SN_BESSEL(name, fcn) \ FloatComplexNDArray \ name (float alpha, const FloatComplexNDArray& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1778,7 +1778,7 @@ #define NS_BESSEL(name, fcn) \ FloatComplexNDArray \ name (const FloatNDArray& alpha, const FloatComplex& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -1786,7 +1786,7 @@ #define NN_BESSEL(name, fcn) \ FloatComplexNDArray \ name (const FloatNDArray& alpha, const FloatComplexNDArray& x, bool scaled, \ - Array<octave_idx_type>& ierr) \ + Array<octave_idx_type>& ierr) \ { \ return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ } @@ -2088,7 +2088,7 @@ static void gripe_betainc_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, - octave_idx_type c3) + octave_idx_type c3) { (*current_liboctave_error_handler) ("betainc: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", @@ -2097,7 +2097,7 @@ static void gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2, - const dim_vector& d3) + const dim_vector& d3) { std::string d1_str = d1.str (); std::string d2_str = d2.str (); @@ -2162,8 +2162,8 @@ retval.resize (a_nr, a_nc); for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = 0; i < a_nr; i++) - retval(i,j) = betainc (x, a(i,j), b(i,j)); + for (octave_idx_type i = 0; i < a_nr; i++) + retval(i,j) = betainc (x, a(i,j), b(i,j)); } else gripe_betainc_nonconformant (1, 1, a_nr, a_nc, b_nr, b_nc); @@ -2212,7 +2212,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x, a(i), b(i)); + retval (i) = betainc (x, a(i), b(i)); } else gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); @@ -2252,8 +2252,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a, b(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a, b(i,j)); } else gripe_betainc_nonconformant (nr, nc, 1, 1, b_nr, b_nc); @@ -2277,8 +2277,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a(i,j), b); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a(i,j), b); } else gripe_betainc_nonconformant (nr, nc, a_nr, a_nc, 1, 1); @@ -2305,8 +2305,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a(i,j), b(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a(i,j), b(i,j)); } else gripe_betainc_nonconformant (nr, nc, a_nr, a_nc, b_nr, b_nc); @@ -2341,7 +2341,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a, b(i)); + retval (i) = betainc (x(i), a, b(i)); } else gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); @@ -2362,7 +2362,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a(i), b); + retval (i) = betainc (x(i), a(i), b); } else gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); @@ -2383,7 +2383,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a(i), b(i)); + retval (i) = betainc (x(i), a(i), b(i)); } else gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); @@ -2445,8 +2445,8 @@ retval.resize (a_nr, a_nc); for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = 0; i < a_nr; i++) - retval(i,j) = betainc (x, a(i,j), b(i,j)); + for (octave_idx_type i = 0; i < a_nr; i++) + retval(i,j) = betainc (x, a(i,j), b(i,j)); } else gripe_betainc_nonconformant (1, 1, a_nr, a_nc, b_nr, b_nc); @@ -2495,7 +2495,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x, a(i), b(i)); + retval (i) = betainc (x, a(i), b(i)); } else gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); @@ -2535,8 +2535,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a, b(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a, b(i,j)); } else gripe_betainc_nonconformant (nr, nc, 1, 1, b_nr, b_nc); @@ -2560,8 +2560,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a(i,j), b); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a(i,j), b); } else gripe_betainc_nonconformant (nr, nc, a_nr, a_nc, 1, 1); @@ -2588,8 +2588,8 @@ retval.resize (nr, nc); for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval(i,j) = betainc (x(i,j), a(i,j), b(i,j)); + for (octave_idx_type i = 0; i < nr; i++) + retval(i,j) = betainc (x(i,j), a(i,j), b(i,j)); } else gripe_betainc_nonconformant (nr, nc, a_nr, a_nc, b_nr, b_nc); @@ -2624,7 +2624,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a, b(i)); + retval (i) = betainc (x(i), a, b(i)); } else gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); @@ -2645,7 +2645,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a(i), b); + retval (i) = betainc (x(i), a(i), b); } else gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); @@ -2666,7 +2666,7 @@ retval.resize (dv); for (octave_idx_type i = 0; i < nel; i++) - retval (i) = betainc (x(i), a(i), b(i)); + retval (i) = betainc (x(i), a(i), b(i)); } else gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); @@ -2686,7 +2686,7 @@ if (a < 0.0 || x < 0.0) { (*current_liboctave_error_handler) - ("gammainc: A and X must be non-negative"); + ("gammainc: A and X must be non-negative"); err = true; } @@ -2710,10 +2710,10 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - result(i,j) = gammainc (x, a(i,j), err); - - if (err) - goto done; + result(i,j) = gammainc (x, a(i,j), err); + + if (err) + goto done; } retval = result; @@ -2737,10 +2737,10 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - result(i,j) = gammainc (x(i,j), a, err); - - if (err) - goto done; + result(i,j) = gammainc (x(i,j), a, err); + + if (err) + goto done; } retval = result; @@ -2769,13 +2769,13 @@ bool err; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - result(i,j) = gammainc (x(i,j), a(i,j), err); - - if (err) - goto done; - } + for (octave_idx_type i = 0; i < nr; i++) + { + result(i,j) = gammainc (x(i,j), a(i,j), err); + + if (err) + goto done; + } retval = result; } @@ -2805,7 +2805,7 @@ result (i) = gammainc (x, a(i), err); if (err) - goto done; + goto done; } retval = result; @@ -2831,7 +2831,7 @@ result (i) = gammainc (x(i), a, err); if (err) - goto done; + goto done; } retval = result; @@ -2857,12 +2857,12 @@ bool err; for (octave_idx_type i = 0; i < nel; i++) - { - result (i) = gammainc (x(i), a(i), err); - - if (err) - goto done; - } + { + result (i) = gammainc (x(i), a(i), err); + + if (err) + goto done; + } retval = result; } @@ -2872,8 +2872,8 @@ std::string a_str = a.dims ().str (); (*current_liboctave_error_handler) - ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", - x_str.c_str (), a_str. c_str ()); + ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", + x_str.c_str (), a_str. c_str ()); } done: @@ -2891,7 +2891,7 @@ if (a < 0.0 || x < 0.0) { (*current_liboctave_error_handler) - ("gammainc: A and X must be non-negative"); + ("gammainc: A and X must be non-negative"); err = true; } @@ -2915,10 +2915,10 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - result(i,j) = gammainc (x, a(i,j), err); - - if (err) - goto done; + result(i,j) = gammainc (x, a(i,j), err); + + if (err) + goto done; } retval = result; @@ -2942,10 +2942,10 @@ for (octave_idx_type j = 0; j < nc; j++) for (octave_idx_type i = 0; i < nr; i++) { - result(i,j) = gammainc (x(i,j), a, err); - - if (err) - goto done; + result(i,j) = gammainc (x(i,j), a, err); + + if (err) + goto done; } retval = result; @@ -2974,13 +2974,13 @@ bool err; for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - result(i,j) = gammainc (x(i,j), a(i,j), err); - - if (err) - goto done; - } + for (octave_idx_type i = 0; i < nr; i++) + { + result(i,j) = gammainc (x(i,j), a(i,j), err); + + if (err) + goto done; + } retval = result; } @@ -3010,7 +3010,7 @@ result (i) = gammainc (x, a(i), err); if (err) - goto done; + goto done; } retval = result; @@ -3036,7 +3036,7 @@ result (i) = gammainc (x(i), a, err); if (err) - goto done; + goto done; } retval = result; @@ -3062,12 +3062,12 @@ bool err; for (octave_idx_type i = 0; i < nel; i++) - { - result (i) = gammainc (x(i), a(i), err); - - if (err) - goto done; - } + { + result (i) = gammainc (x(i), a(i), err); + + if (err) + goto done; + } retval = result; } @@ -3077,8 +3077,8 @@ std::string a_str = a.dims ().str (); (*current_liboctave_error_handler) - ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", - x_str.c_str (), a_str. c_str ()); + ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", + x_str.c_str (), a_str. c_str ()); } done:
--- a/liboctave/lo-sysdep.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/lo-sysdep.cc Thu Feb 11 12:23:32 2010 -0500 @@ -85,7 +85,7 @@ char *upper_case_dir_name = strupr (tmp_path); _chdrive (upper_case_dir_name[0]); if (_getdrive () == upper_case_dir_name[0]) - retval = _chdir2 ("/"); + retval = _chdir2 ("/"); } else retval = _chdir2 (tmp_path); @@ -224,7 +224,7 @@ if (! d->dirty) { if (! FindNextFile(d->hnd, &(d->fd))) - return 0; + return 0; } d->d.d_name = d->fd.cFileName; d->dirty = 0;
--- a/liboctave/lo-utils.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/lo-utils.cc Thu Feb 11 12:23:32 2010 -0500 @@ -171,45 +171,45 @@ do { if (fgets (bufptr, grow_size, f)) - { - len = strlen (bufptr); + { + len = strlen (bufptr); - if (len == grow_size - 1) - { - int tmp = bufptr - buf + grow_size - 1; - grow_size *= 2; - max_size += grow_size; - buf = static_cast<char *> (realloc (buf, max_size)); - bufptr = buf + tmp; + if (len == grow_size - 1) + { + int tmp = bufptr - buf + grow_size - 1; + grow_size *= 2; + max_size += grow_size; + buf = static_cast<char *> (realloc (buf, max_size)); + bufptr = buf + tmp; - if (*(bufptr-1) == '\n') - { - *bufptr = '\0'; - retval = buf; - } - } - else if (bufptr[len-1] != '\n') - { - bufptr[len++] = '\n'; - bufptr[len] = '\0'; - retval = buf; - } - else - retval = buf; - } + if (*(bufptr-1) == '\n') + { + *bufptr = '\0'; + retval = buf; + } + } + else if (bufptr[len-1] != '\n') + { + bufptr[len++] = '\n'; + bufptr[len] = '\0'; + retval = buf; + } + else + retval = buf; + } else - { - if (len == 0) - { - eof = true; + { + if (len == 0) + { + eof = true; - free (buf); + free (buf); - buf = 0; - } + buf = 0; + } - break; - } + break; + } } while (retval.empty ()); @@ -250,36 +250,36 @@ { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') - { - c = is.get (); - if (c == 'f' || c == 'F') - d = sign == '-' ? -octave_Inf : octave_Inf; - else - is.putback (c); - } - else - is.putback (c); + c = is.get (); + if (c == 'n' || c == 'N') + { + c = is.get (); + if (c == 'f' || c == 'F') + d = sign == '-' ? -octave_Inf : octave_Inf; + else + is.putback (c); + } + else + is.putback (c); } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') - { - c = is.get (); - if (c == 'n' || c == 'N') - d = octave_NaN; - else - { - is.putback (c); - d = octave_NA; - } - } - else - is.putback (c); + c = is.get (); + if (c == 'a' || c == 'A') + { + c = is.get (); + if (c == 'n' || c == 'N') + d = octave_NaN; + else + { + is.putback (c); + d = octave_NA; + } + } + else + is.putback (c); } break; @@ -305,31 +305,31 @@ { case '-': { - char c2 = 0; - c2 = is.get (); - if (c2 == 'i' || c2 == 'I') - d = read_inf_nan_na (is, c2, c1); - else - { - is.putback (c2); - is.putback (c1); - is >> d; - } + char c2 = 0; + c2 = is.get (); + if (c2 == 'i' || c2 == 'I') + d = read_inf_nan_na (is, c2, c1); + else + { + is.putback (c2); + is.putback (c1); + is >> d; + } } break; case '+': { - char c2 = 0; - c2 = is.get (); - if (c2 == 'i' || c2 == 'I') - d = read_inf_nan_na (is, c2, c1); - else - { - is.putback (c2); - is.putback (c1); - is >> d; - } + char c2 = 0; + c2 = is.get (); + if (c2 == 'i' || c2 == 'I') + d = read_inf_nan_na (is, c2, c1); + else + { + is.putback (c2); + is.putback (c1); + is >> d; + } } break; @@ -365,19 +365,19 @@ ch = is.get (); if (ch == ',') - { - im = octave_read_value<double> (is); - ch = is.get (); + { + im = octave_read_value<double> (is); + ch = is.get (); - if (ch == ')') - cx = Complex (re, im); - else - is.setstate (std::ios::failbit); - } + if (ch == ')') + cx = Complex (re, im); + else + is.setstate (std::ios::failbit); + } else if (ch == ')') - cx = re; + cx = re; else - is.setstate (std::ios::failbit); + is.setstate (std::ios::failbit); } else { @@ -398,36 +398,36 @@ { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') - { - c = is.get (); - if (c == 'f' || c == 'F') - d = sign == '-' ? -octave_Inf : octave_Inf; - else - is.putback (c); - } - else - is.putback (c); + c = is.get (); + if (c == 'n' || c == 'N') + { + c = is.get (); + if (c == 'f' || c == 'F') + d = sign == '-' ? -octave_Inf : octave_Inf; + else + is.putback (c); + } + else + is.putback (c); } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') - { - c = is.get (); - if (c == 'n' || c == 'N') - d = octave_NaN; - else - { - is.putback (c); - d = octave_NA; - } - } - else - is.putback (c); + c = is.get (); + if (c == 'a' || c == 'A') + { + c = is.get (); + if (c == 'n' || c == 'N') + d = octave_NaN; + else + { + is.putback (c); + d = octave_NA; + } + } + else + is.putback (c); } break; @@ -453,31 +453,31 @@ { case '-': { - char c2 = 0; - c2 = is.get (); - if (c2 == 'i' || c2 == 'I') - d = read_float_inf_nan_na (is, c2, c1); - else - { - is.putback (c2); - is.putback (c1); - is >> d; - } + char c2 = 0; + c2 = is.get (); + if (c2 == 'i' || c2 == 'I') + d = read_float_inf_nan_na (is, c2, c1); + else + { + is.putback (c2); + is.putback (c1); + is >> d; + } } break; case '+': { - char c2 = 0; - c2 = is.get (); - if (c2 == 'i' || c2 == 'I') - d = read_float_inf_nan_na (is, c2, c1); - else - { - is.putback (c2); - is.putback (c1); - is >> d; - } + char c2 = 0; + c2 = is.get (); + if (c2 == 'i' || c2 == 'I') + d = read_float_inf_nan_na (is, c2, c1); + else + { + is.putback (c2); + is.putback (c1); + is >> d; + } } break; @@ -513,19 +513,19 @@ ch = is.get (); if (ch == ',') - { - im = octave_read_value<float> (is); - ch = is.get (); + { + im = octave_read_value<float> (is); + ch = is.get (); - if (ch == ')') - cx = FloatComplex (re, im); - else - is.setstate (std::ios::failbit); - } + if (ch == ')') + cx = FloatComplex (re, im); + else + is.setstate (std::ios::failbit); + } else if (ch == ')') - cx = re; + cx = re; else - is.setstate (std::ios::failbit); + is.setstate (std::ios::failbit); } else {
--- a/liboctave/mach-info.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/mach-info.cc Thu Feb 11 12:23:32 2010 -0500 @@ -84,34 +84,34 @@ float_params fp[5]; INIT_FLT_PAR (fp[0], oct_mach_info::flt_fmt_ieee_big_endian, - 1048576, 0, - 2146435071, -1, - 1017118720, 0, - 1018167296, 0); + 1048576, 0, + 2146435071, -1, + 1017118720, 0, + 1018167296, 0); INIT_FLT_PAR (fp[1], oct_mach_info::flt_fmt_ieee_little_endian, - 0, 1048576, - -1, 2146435071, - 0, 1017118720, - 0, 1018167296); + 0, 1048576, + -1, 2146435071, + 0, 1017118720, + 0, 1018167296); INIT_FLT_PAR (fp[2], oct_mach_info::flt_fmt_vax_d, - 128, 0, - -32769, -1, - 9344, 0, - 9344, 0); + 128, 0, + -32769, -1, + 9344, 0, + 9344, 0); INIT_FLT_PAR (fp[3], oct_mach_info::flt_fmt_vax_g, - 16, 0, - -32769, -1, - 15552, 0, - 15552, 0); + 16, 0, + -32769, -1, + 15552, 0, + 15552, 0); INIT_FLT_PAR (fp[4], oct_mach_info::flt_fmt_unknown, - 0, 0, - 0, 0, - 0, 0, - 0, 0); + 0, 0, + 0, 0, + 0, 0, + 0, 0); equiv mach_fp_par[4]; @@ -124,10 +124,10 @@ do { if (equiv_compare (fp[i].fp_par, mach_fp_par, 4)) - { - native_float_fmt = fp[i].fp_fmt; - break; - } + { + native_float_fmt = fp[i].fp_fmt; + break; + } } while (fp[++i].fp_fmt != oct_mach_info::flt_fmt_unknown); @@ -167,7 +167,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create command history object!"); + ("unable to create command history object!"); retval = false; }
--- a/liboctave/mx-inlines.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/mx-inlines.cc Thu Feb 11 12:23:32 2010 -0500 @@ -421,9 +421,9 @@ R *r = 0; \ if (n > 0) \ { \ - r = new R [n]; \ - for (size_t i = 0; i < n; i++) \ - r[i] = OP (x[i]); \ + r = new R [n]; \ + for (size_t i = 0; i < n; i++) \ + r[i] = OP (x[i]); \ } \ return r; \ } @@ -1055,8 +1055,8 @@ break; case 2: if (n > 1) - { - T lst = v[1] - v[0]; + { + T lst = v[1] - v[0]; for (octave_idx_type i = 0; i < n-2; i++) { T dif = v[i+2] - v[i+1];
--- a/liboctave/oct-alloc.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-alloc.cc Thu Feb 11 12:23:32 2010 -0500 @@ -38,7 +38,7 @@ if (! head) { if (! grow ()) - return 0; + return 0; } link *tmp = head; @@ -77,12 +77,12 @@ char *p = start; while (p < last) - { - char *next = p + item_size; - (reinterpret_cast<link *> (p)) -> next - = reinterpret_cast<link *> (next); - p = next; - } + { + char *next = p + item_size; + (reinterpret_cast<link *> (p)) -> next + = reinterpret_cast<link *> (next); + p = next; + } (reinterpret_cast<link *> (last)) -> next = 0; @@ -96,7 +96,7 @@ std::set_new_handler (f); if (f) - f (); + f (); retval = false; }
--- a/liboctave/oct-env.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-env.cc Thu Feb 11 12:23:32 2010 -0500 @@ -87,7 +87,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create current working directory object!"); + ("unable to create current working directory object!"); retval = false; } @@ -266,7 +266,7 @@ #if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) if ((len == 2 && isalpha (s[0]) && s[1] == ':') || (len > 2 && isalpha (s[0]) && s[1] == ':' - && file_ops::is_dir_sep (s[2]))) + && file_ops::is_dir_sep (s[2]))) return true; #endif @@ -319,7 +319,7 @@ std::string octave_env::do_make_absolute (const std::string& s, - const std::string& dot_path) const + const std::string& dot_path) const { #if defined (__EMX__) if (s.length () > 1 && s[1] == ':') @@ -347,42 +347,42 @@ while (i < slen) { if (s[i] == '.') - { - if (i + 1 == slen) - return current_dir; + { + if (i + 1 == slen) + return current_dir; - if (file_ops::is_dir_sep (s[i+1])) - { - i += 2; - continue; - } + if (file_ops::is_dir_sep (s[i+1])) + { + i += 2; + continue; + } - if (s[i+1] == '.' - && (i + 2 == slen || file_ops::is_dir_sep (s[i+2]))) - { - i += 2; + if (s[i+1] == '.' + && (i + 2 == slen || file_ops::is_dir_sep (s[i+2]))) + { + i += 2; - if (i != slen) - i++; + if (i != slen) + i++; - pathname_backup (current_dir, 1); + pathname_backup (current_dir, 1); - continue; - } - } + continue; + } + } size_t tmp = s.find_first_of (file_ops::dir_sep_chars (), i); if (tmp == std::string::npos) - { - current_dir.append (s, i, tmp-i); - break; - } + { + current_dir.append (s, i, tmp-i); + break; + } else - { - current_dir.append (s, i, tmp-i+1); - i = tmp + 1; - } + { + current_dir.append (s, i, tmp-i+1); + i = tmp + 1; + } } return current_dir; @@ -416,9 +416,9 @@ { std::string drv = do_getenv ("HOMEDRIVE"); if (drv.empty ()) - hd = do_getenv ("HOMEPATH"); + hd = do_getenv ("HOMEPATH"); else - hd = drv + do_getenv ("HOMEPATH"); + hd = drv + do_getenv ("HOMEPATH"); } #endif @@ -481,28 +481,28 @@ if (follow_symbolic_links) { if (current_directory.empty ()) - do_getcwd (); + do_getcwd (); if (current_directory.empty ()) - tmp = newdir; + tmp = newdir; else - tmp = do_make_absolute (newdir, current_directory); + tmp = do_make_absolute (newdir, current_directory); // Get rid of trailing directory separator. size_t len = tmp.length (); if (len > 1) - { - if (file_ops::is_dir_sep (tmp[--len])) - tmp.resize (len); - } + { + if (file_ops::is_dir_sep (tmp[--len])) + tmp.resize (len); + } if (! ::octave_chdir (tmp)) - { - current_directory = tmp; - retval = true; - } + { + current_directory = tmp; + retval = true; + } } else retval = (! ::octave_chdir (newdir)); @@ -523,10 +523,10 @@ while (n--) { while (file_ops::is_dir_sep (path[i]) && i > 0) - i--; + i--; while (! file_ops::is_dir_sep (path[i]) && i > 0) - i--; + i--; i++; }
--- a/liboctave/oct-fftw.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-fftw.cc Thu Feb 11 12:23:32 2010 -0500 @@ -85,7 +85,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create octave_fftw_planner object!"); + ("unable to create octave_fftw_planner object!"); retval = false; } @@ -98,11 +98,11 @@ fftw_plan octave_fftw_planner::do_create_plan (int dir, const int rank, - const dim_vector dims, - octave_idx_type howmany, - octave_idx_type stride, - octave_idx_type dist, - const Complex *in, Complex *out) + const dim_vector dims, + octave_idx_type howmany, + octave_idx_type stride, + octave_idx_type dist, + const Complex *in, Complex *out) { int which = (dir == FFTW_FORWARD) ? 0 : 1; fftw_plan *cur_plan_p = &plan[which]; @@ -124,11 +124,11 @@ // We still might not have the same shape of array. for (int i = 0; i < rank; i++) - if (dims(i) != n[which](i)) - { - create_new_plan = true; - break; - } + if (dims(i) != n[which](i)) + { + create_new_plan = true; + break; + } } if (create_new_plan) @@ -146,74 +146,74 @@ OCTAVE_LOCAL_BUFFER (int, tmp, rank); for (int i = 0, j = rank-1; i < rank; i++, j--) - { - tmp[i] = dims(j); - nn *= dims(j); - } + { + tmp[i] = dims(j); + nn *= dims(j); + } int plan_flags = 0; bool plan_destroys_in = true; switch (meth) - { - case UNKNOWN: - case ESTIMATE: - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - break; - case MEASURE: - plan_flags |= FFTW_MEASURE; - break; - case PATIENT: - plan_flags |= FFTW_PATIENT; - break; - case EXHAUSTIVE: - plan_flags |= FFTW_EXHAUSTIVE; - break; - case HYBRID: - if (nn < 8193) - plan_flags |= FFTW_MEASURE; - else - { - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - } - break; - } + { + case UNKNOWN: + case ESTIMATE: + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + break; + case MEASURE: + plan_flags |= FFTW_MEASURE; + break; + case PATIENT: + plan_flags |= FFTW_PATIENT; + break; + case EXHAUSTIVE: + plan_flags |= FFTW_EXHAUSTIVE; + break; + case HYBRID: + if (nn < 8193) + plan_flags |= FFTW_MEASURE; + else + { + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + } + break; + } if (ioalign) - plan_flags &= ~FFTW_UNALIGNED; + plan_flags &= ~FFTW_UNALIGNED; else - plan_flags |= FFTW_UNALIGNED; + plan_flags |= FFTW_UNALIGNED; if (*cur_plan_p) - fftw_destroy_plan (*cur_plan_p); + fftw_destroy_plan (*cur_plan_p); if (plan_destroys_in) - { - // Create matrix with the same size and 16-byte alignment as input - OCTAVE_LOCAL_BUFFER (Complex, itmp, nn * howmany + 32); - itmp = reinterpret_cast<Complex *> - (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + - ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); + { + // Create matrix with the same size and 16-byte alignment as input + OCTAVE_LOCAL_BUFFER (Complex, itmp, nn * howmany + 32); + itmp = reinterpret_cast<Complex *> + (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + + ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); - *cur_plan_p = - fftw_plan_many_dft (rank, tmp, howmany, - reinterpret_cast<fftw_complex *> (itmp), - 0, stride, dist, reinterpret_cast<fftw_complex *> (out), - 0, stride, dist, dir, plan_flags); - } + *cur_plan_p = + fftw_plan_many_dft (rank, tmp, howmany, + reinterpret_cast<fftw_complex *> (itmp), + 0, stride, dist, reinterpret_cast<fftw_complex *> (out), + 0, stride, dist, dir, plan_flags); + } else - { - *cur_plan_p = - fftw_plan_many_dft (rank, tmp, howmany, - reinterpret_cast<fftw_complex *> (const_cast<Complex *> (in)), - 0, stride, dist, reinterpret_cast<fftw_complex *> (out), - 0, stride, dist, dir, plan_flags); - } + { + *cur_plan_p = + fftw_plan_many_dft (rank, tmp, howmany, + reinterpret_cast<fftw_complex *> (const_cast<Complex *> (in)), + 0, stride, dist, reinterpret_cast<fftw_complex *> (out), + 0, stride, dist, dir, plan_flags); + } if (*cur_plan_p == 0) - (*current_liboctave_error_handler) ("Error creating fftw plan"); + (*current_liboctave_error_handler) ("Error creating fftw plan"); } return *cur_plan_p; @@ -221,10 +221,10 @@ fftw_plan octave_fftw_planner::do_create_plan (const int rank, const dim_vector dims, - octave_idx_type howmany, - octave_idx_type stride, - octave_idx_type dist, - const double *in, Complex *out) + octave_idx_type howmany, + octave_idx_type stride, + octave_idx_type dist, + const double *in, Complex *out) { fftw_plan *cur_plan_p = &rplan; bool create_new_plan = false; @@ -242,11 +242,11 @@ // We still might not have the same shape of array. for (int i = 0; i < rank; i++) - if (dims(i) != rn(i)) - { - create_new_plan = true; - break; - } + if (dims(i) != rn(i)) + { + create_new_plan = true; + break; + } } if (create_new_plan) @@ -263,73 +263,73 @@ OCTAVE_LOCAL_BUFFER (int, tmp, rank); for (int i = 0, j = rank-1; i < rank; i++, j--) - { - tmp[i] = dims(j); - nn *= dims(j); - } + { + tmp[i] = dims(j); + nn *= dims(j); + } int plan_flags = 0; bool plan_destroys_in = true; switch (meth) - { - case UNKNOWN: - case ESTIMATE: - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - break; - case MEASURE: - plan_flags |= FFTW_MEASURE; - break; - case PATIENT: - plan_flags |= FFTW_PATIENT; - break; - case EXHAUSTIVE: - plan_flags |= FFTW_EXHAUSTIVE; - break; - case HYBRID: - if (nn < 8193) - plan_flags |= FFTW_MEASURE; - else - { - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - } - break; - } + { + case UNKNOWN: + case ESTIMATE: + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + break; + case MEASURE: + plan_flags |= FFTW_MEASURE; + break; + case PATIENT: + plan_flags |= FFTW_PATIENT; + break; + case EXHAUSTIVE: + plan_flags |= FFTW_EXHAUSTIVE; + break; + case HYBRID: + if (nn < 8193) + plan_flags |= FFTW_MEASURE; + else + { + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + } + break; + } if (ioalign) - plan_flags &= ~FFTW_UNALIGNED; + plan_flags &= ~FFTW_UNALIGNED; else - plan_flags |= FFTW_UNALIGNED; + plan_flags |= FFTW_UNALIGNED; if (*cur_plan_p) - fftw_destroy_plan (*cur_plan_p); + fftw_destroy_plan (*cur_plan_p); if (plan_destroys_in) - { - // Create matrix with the same size and 16-byte alignment as input - OCTAVE_LOCAL_BUFFER (double, itmp, nn + 32); - itmp = reinterpret_cast<double *> - (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + - ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); + { + // Create matrix with the same size and 16-byte alignment as input + OCTAVE_LOCAL_BUFFER (double, itmp, nn + 32); + itmp = reinterpret_cast<double *> + (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + + ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); - *cur_plan_p = - fftw_plan_many_dft_r2c (rank, tmp, howmany, itmp, - 0, stride, dist, reinterpret_cast<fftw_complex *> (out), - 0, stride, dist, plan_flags); - } + *cur_plan_p = + fftw_plan_many_dft_r2c (rank, tmp, howmany, itmp, + 0, stride, dist, reinterpret_cast<fftw_complex *> (out), + 0, stride, dist, plan_flags); + } else - { - *cur_plan_p = - fftw_plan_many_dft_r2c (rank, tmp, howmany, - (const_cast<double *> (in)), - 0, stride, dist, reinterpret_cast<fftw_complex *> (out), - 0, stride, dist, plan_flags); - } + { + *cur_plan_p = + fftw_plan_many_dft_r2c (rank, tmp, howmany, + (const_cast<double *> (in)), + 0, stride, dist, reinterpret_cast<fftw_complex *> (out), + 0, stride, dist, plan_flags); + } if (*cur_plan_p == 0) - (*current_liboctave_error_handler) ("Error creating fftw plan"); + (*current_liboctave_error_handler) ("Error creating fftw plan"); } return *cur_plan_p; @@ -350,16 +350,16 @@ || _meth == HYBRID) { if (meth != _meth) - { - meth = _meth; - if (rplan) - fftw_destroy_plan (rplan); - if (plan[0]) - fftw_destroy_plan (plan[0]); - if (plan[1]) - fftw_destroy_plan (plan[1]); - rplan = plan[0] = plan[1] = 0; - } + { + meth = _meth; + if (rplan) + fftw_destroy_plan (rplan); + if (plan[0]) + fftw_destroy_plan (plan[0]); + if (plan[1]) + fftw_destroy_plan (plan[1]); + rplan = plan[0] = plan[1] = 0; + } } else ret = UNKNOWN; @@ -398,7 +398,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create octave_fftw_planner object!"); + ("unable to create octave_fftw_planner object!"); retval = false; } @@ -408,12 +408,12 @@ fftwf_plan octave_float_fftw_planner::do_create_plan (int dir, const int rank, - const dim_vector dims, - octave_idx_type howmany, - octave_idx_type stride, - octave_idx_type dist, - const FloatComplex *in, - FloatComplex *out) + const dim_vector dims, + octave_idx_type howmany, + octave_idx_type stride, + octave_idx_type dist, + const FloatComplex *in, + FloatComplex *out) { int which = (dir == FFTW_FORWARD) ? 0 : 1; fftwf_plan *cur_plan_p = &plan[which]; @@ -435,11 +435,11 @@ // We still might not have the same shape of array. for (int i = 0; i < rank; i++) - if (dims(i) != n[which](i)) - { - create_new_plan = true; - break; - } + if (dims(i) != n[which](i)) + { + create_new_plan = true; + break; + } } if (create_new_plan) @@ -457,74 +457,74 @@ OCTAVE_LOCAL_BUFFER (int, tmp, rank); for (int i = 0, j = rank-1; i < rank; i++, j--) - { - tmp[i] = dims(j); - nn *= dims(j); - } + { + tmp[i] = dims(j); + nn *= dims(j); + } int plan_flags = 0; bool plan_destroys_in = true; switch (meth) - { - case UNKNOWN: - case ESTIMATE: - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - break; - case MEASURE: - plan_flags |= FFTW_MEASURE; - break; - case PATIENT: - plan_flags |= FFTW_PATIENT; - break; - case EXHAUSTIVE: - plan_flags |= FFTW_EXHAUSTIVE; - break; - case HYBRID: - if (nn < 8193) - plan_flags |= FFTW_MEASURE; - else - { - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - } - break; - } + { + case UNKNOWN: + case ESTIMATE: + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + break; + case MEASURE: + plan_flags |= FFTW_MEASURE; + break; + case PATIENT: + plan_flags |= FFTW_PATIENT; + break; + case EXHAUSTIVE: + plan_flags |= FFTW_EXHAUSTIVE; + break; + case HYBRID: + if (nn < 8193) + plan_flags |= FFTW_MEASURE; + else + { + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + } + break; + } if (ioalign) - plan_flags &= ~FFTW_UNALIGNED; + plan_flags &= ~FFTW_UNALIGNED; else - plan_flags |= FFTW_UNALIGNED; + plan_flags |= FFTW_UNALIGNED; if (*cur_plan_p) - fftwf_destroy_plan (*cur_plan_p); + fftwf_destroy_plan (*cur_plan_p); if (plan_destroys_in) - { - // Create matrix with the same size and 16-byte alignment as input - OCTAVE_LOCAL_BUFFER (FloatComplex, itmp, nn * howmany + 32); - itmp = reinterpret_cast<FloatComplex *> - (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + - ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); + { + // Create matrix with the same size and 16-byte alignment as input + OCTAVE_LOCAL_BUFFER (FloatComplex, itmp, nn * howmany + 32); + itmp = reinterpret_cast<FloatComplex *> + (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + + ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); - *cur_plan_p = - fftwf_plan_many_dft (rank, tmp, howmany, - reinterpret_cast<fftwf_complex *> (itmp), - 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), - 0, stride, dist, dir, plan_flags); - } + *cur_plan_p = + fftwf_plan_many_dft (rank, tmp, howmany, + reinterpret_cast<fftwf_complex *> (itmp), + 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), + 0, stride, dist, dir, plan_flags); + } else - { - *cur_plan_p = - fftwf_plan_many_dft (rank, tmp, howmany, - reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *> (in)), - 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), - 0, stride, dist, dir, plan_flags); - } + { + *cur_plan_p = + fftwf_plan_many_dft (rank, tmp, howmany, + reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *> (in)), + 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), + 0, stride, dist, dir, plan_flags); + } if (*cur_plan_p == 0) - (*current_liboctave_error_handler) ("Error creating fftw plan"); + (*current_liboctave_error_handler) ("Error creating fftw plan"); } return *cur_plan_p; @@ -532,11 +532,11 @@ fftwf_plan octave_float_fftw_planner::do_create_plan (const int rank, - const dim_vector dims, - octave_idx_type howmany, - octave_idx_type stride, - octave_idx_type dist, - const float *in, FloatComplex *out) + const dim_vector dims, + octave_idx_type howmany, + octave_idx_type stride, + octave_idx_type dist, + const float *in, FloatComplex *out) { fftwf_plan *cur_plan_p = &rplan; bool create_new_plan = false; @@ -554,11 +554,11 @@ // We still might not have the same shape of array. for (int i = 0; i < rank; i++) - if (dims(i) != rn(i)) - { - create_new_plan = true; - break; - } + if (dims(i) != rn(i)) + { + create_new_plan = true; + break; + } } if (create_new_plan) @@ -575,73 +575,73 @@ OCTAVE_LOCAL_BUFFER (int, tmp, rank); for (int i = 0, j = rank-1; i < rank; i++, j--) - { - tmp[i] = dims(j); - nn *= dims(j); - } + { + tmp[i] = dims(j); + nn *= dims(j); + } int plan_flags = 0; bool plan_destroys_in = true; switch (meth) - { - case UNKNOWN: - case ESTIMATE: - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - break; - case MEASURE: - plan_flags |= FFTW_MEASURE; - break; - case PATIENT: - plan_flags |= FFTW_PATIENT; - break; - case EXHAUSTIVE: - plan_flags |= FFTW_EXHAUSTIVE; - break; - case HYBRID: - if (nn < 8193) - plan_flags |= FFTW_MEASURE; - else - { - plan_flags |= FFTW_ESTIMATE; - plan_destroys_in = false; - } - break; - } + { + case UNKNOWN: + case ESTIMATE: + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + break; + case MEASURE: + plan_flags |= FFTW_MEASURE; + break; + case PATIENT: + plan_flags |= FFTW_PATIENT; + break; + case EXHAUSTIVE: + plan_flags |= FFTW_EXHAUSTIVE; + break; + case HYBRID: + if (nn < 8193) + plan_flags |= FFTW_MEASURE; + else + { + plan_flags |= FFTW_ESTIMATE; + plan_destroys_in = false; + } + break; + } if (ioalign) - plan_flags &= ~FFTW_UNALIGNED; + plan_flags &= ~FFTW_UNALIGNED; else - plan_flags |= FFTW_UNALIGNED; + plan_flags |= FFTW_UNALIGNED; if (*cur_plan_p) - fftwf_destroy_plan (*cur_plan_p); + fftwf_destroy_plan (*cur_plan_p); if (plan_destroys_in) - { - // Create matrix with the same size and 16-byte alignment as input - OCTAVE_LOCAL_BUFFER (float, itmp, nn + 32); - itmp = reinterpret_cast<float *> - (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + - ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); + { + // Create matrix with the same size and 16-byte alignment as input + OCTAVE_LOCAL_BUFFER (float, itmp, nn + 32); + itmp = reinterpret_cast<float *> + (((reinterpret_cast<ptrdiff_t>(itmp) + 15) & ~ 0xF) + + ((reinterpret_cast<ptrdiff_t> (in)) & 0xF)); - *cur_plan_p = - fftwf_plan_many_dft_r2c (rank, tmp, howmany, itmp, - 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), - 0, stride, dist, plan_flags); - } + *cur_plan_p = + fftwf_plan_many_dft_r2c (rank, tmp, howmany, itmp, + 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), + 0, stride, dist, plan_flags); + } else - { - *cur_plan_p = - fftwf_plan_many_dft_r2c (rank, tmp, howmany, - (const_cast<float *> (in)), - 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), - 0, stride, dist, plan_flags); - } + { + *cur_plan_p = + fftwf_plan_many_dft_r2c (rank, tmp, howmany, + (const_cast<float *> (in)), + 0, stride, dist, reinterpret_cast<fftwf_complex *> (out), + 0, stride, dist, plan_flags); + } if (*cur_plan_p == 0) - (*current_liboctave_error_handler) ("Error creating fftw plan"); + (*current_liboctave_error_handler) ("Error creating fftw plan"); } return *cur_plan_p; @@ -662,16 +662,16 @@ || _meth == HYBRID) { if (meth != _meth) - { - meth = _meth; - if (rplan) - fftwf_destroy_plan (rplan); - if (plan[0]) - fftwf_destroy_plan (plan[0]); - if (plan[1]) - fftwf_destroy_plan (plan[1]); - rplan = plan[0] = plan[1] = 0; - } + { + meth = _meth; + if (rplan) + fftwf_destroy_plan (rplan); + if (plan[0]) + fftwf_destroy_plan (plan[0]); + if (plan[1]) + fftwf_destroy_plan (plan[1]); + rplan = plan[0] = plan[1] = 0; + } } else ret = UNKNOWN; @@ -681,7 +681,7 @@ template <class T> static inline void convert_packcomplex_1d (T *out, size_t nr, size_t nc, - octave_idx_type stride, octave_idx_type dist) + octave_idx_type stride, octave_idx_type dist) { octave_quit (); @@ -713,7 +713,7 @@ ptr1 = out + i * (nc/2 + 1) + nrp*((nc-1)/2); ptr2 = out + i * nc; for (size_t j = 0; j < nc/2+1; j++) - *ptr2++ = *ptr1++; + *ptr2++ = *ptr1++; } octave_quit (); @@ -723,11 +723,11 @@ for (size_t i = 0; i < np; i++) { for (size_t j = 1; j < nr; j++) - for (size_t k = nc/2+1; k < nc; k++) - out[k + (j + i*nr)*nc] = conj(out[nc - k + ((i+1)*nr - j)*nc]); + for (size_t k = nc/2+1; k < nc; k++) + out[k + (j + i*nr)*nc] = conj(out[nc - k + ((i+1)*nr - j)*nc]); for (size_t j = nc/2+1; j < nc; j++) - out[j + i*nr*nc] = conj(out[(i*nr+1)*nc - j]); + out[j + i*nr*nc] = conj(out[(i*nr+1)*nc - j]); } octave_quit (); @@ -742,15 +742,15 @@ { size_t jmax = jstart * dv(inner); for (size_t i = 0; i < nel; i+=jmax) - for (size_t j = jstart, jj = jmax-jstart; j < jj; - j+=jstart, jj-=jstart) - for (size_t k = 0; k < jstart; k+= kstep) - for (size_t l = nc/2+1; l < nc; l++) - { - T tmp = out[i+ j + k + l]; - out[i + j + k + l] = out[i + jj + k + l]; - out[i + jj + k + l] = tmp; - } + for (size_t j = jstart, jj = jmax-jstart; j < jj; + j+=jstart, jj-=jstart) + for (size_t k = 0; k < jstart; k+= kstep) + for (size_t l = nc/2+1; l < nc; l++) + { + T tmp = out[i+ j + k + l]; + out[i + j + k + l] = out[i + jj + k + l]; + out[i + jj + k + l] = tmp; + } jstart = jmax; } @@ -759,16 +759,16 @@ int octave_fftw::fft (const double *in, Complex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftw_plan plan = octave_fftw_planner::create_plan (1, dv, nsamples, - stride, dist, in, out); + stride, dist, in, out); fftw_execute_dft_r2c (plan, (const_cast<double *>(in)), - reinterpret_cast<fftw_complex *> (out)); + reinterpret_cast<fftw_complex *> (out)); // Need to create other half of the transform. @@ -779,36 +779,36 @@ int octave_fftw::fft (const Complex *in, Complex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftw_plan plan = octave_fftw_planner::create_plan (FFTW_FORWARD, 1, dv, - nsamples, stride, - dist, in, out); + nsamples, stride, + dist, in, out); fftw_execute_dft (plan, - reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), - reinterpret_cast<fftw_complex *> (out)); + reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), + reinterpret_cast<fftw_complex *> (out)); return 0; } int octave_fftw::ifft (const Complex *in, Complex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftw_plan plan = octave_fftw_planner::create_plan (FFTW_BACKWARD, 1, dv, - nsamples, stride, - dist, in, out); + nsamples, stride, + dist, in, out); fftw_execute_dft (plan, - reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), - reinterpret_cast<fftw_complex *> (out)); + reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), + reinterpret_cast<fftw_complex *> (out)); const Complex scale = npts; for (size_t j = 0; j < nsamples; j++) @@ -820,7 +820,7 @@ int octave_fftw::fftNd (const double *in, Complex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) @@ -832,10 +832,10 @@ octave_idx_type offset = (dv.numel () / dv(0)) * ((dv(0) - 1) / 2); fftw_plan plan = octave_fftw_planner::create_plan (rank, dv, 1, 1, dist, - in, out + offset); + in, out + offset); fftw_execute_dft_r2c (plan, (const_cast<double *>(in)), - reinterpret_cast<fftw_complex *> (out+ offset)); + reinterpret_cast<fftw_complex *> (out+ offset)); // Need to create other half of the transform. @@ -846,36 +846,36 @@ int octave_fftw::fftNd (const Complex *in, Complex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) dist *= dv(i); fftw_plan plan = octave_fftw_planner::create_plan (FFTW_FORWARD, rank, - dv, 1, 1, dist, in, out); + dv, 1, 1, dist, in, out); fftw_execute_dft (plan, - reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), - reinterpret_cast<fftw_complex *> (out)); + reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), + reinterpret_cast<fftw_complex *> (out)); return 0; } int octave_fftw::ifftNd (const Complex *in, Complex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) dist *= dv(i); fftw_plan plan = octave_fftw_planner::create_plan (FFTW_BACKWARD, rank, - dv, 1, 1, dist, in, out); + dv, 1, 1, dist, in, out); fftw_execute_dft (plan, - reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), - reinterpret_cast<fftw_complex *> (out)); + reinterpret_cast<fftw_complex *> (const_cast<Complex *>(in)), + reinterpret_cast<fftw_complex *> (out)); const size_t npts = dv.numel (); const Complex scale = npts; @@ -887,17 +887,17 @@ int octave_fftw::fft (const float *in, FloatComplex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftwf_plan plan = octave_float_fftw_planner::create_plan (1, dv, nsamples, - stride, dist, - in, out); + stride, dist, + in, out); fftwf_execute_dft_r2c (plan, (const_cast<float *>(in)), - reinterpret_cast<fftwf_complex *> (out)); + reinterpret_cast<fftwf_complex *> (out)); // Need to create other half of the transform. @@ -908,38 +908,38 @@ int octave_fftw::fft (const FloatComplex *in, FloatComplex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftwf_plan plan = octave_float_fftw_planner::create_plan (FFTW_FORWARD, 1, - dv, nsamples, - stride, dist, - in, out); + dv, nsamples, + stride, dist, + in, out); fftwf_execute_dft (plan, - reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), - reinterpret_cast<fftwf_complex *> (out)); + reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), + reinterpret_cast<fftwf_complex *> (out)); return 0; } int octave_fftw::ifft (const FloatComplex *in, FloatComplex *out, size_t npts, - size_t nsamples, octave_idx_type stride, octave_idx_type dist) + size_t nsamples, octave_idx_type stride, octave_idx_type dist) { dist = (dist < 0 ? npts : dist); dim_vector dv (npts); fftwf_plan plan = octave_float_fftw_planner::create_plan (FFTW_BACKWARD, 1, - dv, nsamples, - stride, dist, - in, out); + dv, nsamples, + stride, dist, + in, out); fftwf_execute_dft (plan, - reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), - reinterpret_cast<fftwf_complex *> (out)); + reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), + reinterpret_cast<fftwf_complex *> (out)); const FloatComplex scale = npts; for (size_t j = 0; j < nsamples; j++) @@ -951,7 +951,7 @@ int octave_fftw::fftNd (const float *in, FloatComplex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) @@ -963,11 +963,11 @@ octave_idx_type offset = (dv.numel () / dv(0)) * ((dv(0) - 1) / 2); fftwf_plan plan = octave_float_fftw_planner::create_plan (rank, dv, 1, 1, - dist, in, - out + offset); + dist, in, + out + offset); fftwf_execute_dft_r2c (plan, (const_cast<float *>(in)), - reinterpret_cast<fftwf_complex *> (out+ offset)); + reinterpret_cast<fftwf_complex *> (out+ offset)); // Need to create other half of the transform. @@ -978,38 +978,38 @@ int octave_fftw::fftNd (const FloatComplex *in, FloatComplex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) dist *= dv(i); fftwf_plan plan = octave_float_fftw_planner::create_plan (FFTW_FORWARD, - rank, dv, 1, 1, - dist, in, out); + rank, dv, 1, 1, + dist, in, out); fftwf_execute_dft (plan, - reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), - reinterpret_cast<fftwf_complex *> (out)); + reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), + reinterpret_cast<fftwf_complex *> (out)); return 0; } int octave_fftw::ifftNd (const FloatComplex *in, FloatComplex *out, const int rank, - const dim_vector &dv) + const dim_vector &dv) { octave_idx_type dist = 1; for (int i = 0; i < rank; i++) dist *= dv(i); fftwf_plan plan = octave_float_fftw_planner::create_plan (FFTW_BACKWARD, - rank, dv, 1, 1, - dist, in, out); + rank, dv, 1, 1, + dist, in, out); fftwf_execute_dft (plan, - reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), - reinterpret_cast<fftwf_complex *> (out)); + reinterpret_cast<fftwf_complex *> (const_cast<FloatComplex *>(in)), + reinterpret_cast<fftwf_complex *> (out)); const size_t npts = dv.numel (); const FloatComplex scale = npts;
--- a/liboctave/oct-glob.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-glob.cc Thu Feb 11 12:23:32 2010 -0500 @@ -75,35 +75,35 @@ std::string xpat = pat(i); if (! xpat.empty ()) - { - glob_t glob_info; + { + glob_t glob_info; - int err = ::glob (xpat.c_str (), GLOB_NOSORT, 0, &glob_info); + int err = ::glob (xpat.c_str (), GLOB_NOSORT, 0, &glob_info); - if (! err) - { - int n = glob_info.gl_pathc; + if (! err) + { + int n = glob_info.gl_pathc; - const char * const *matches = glob_info.gl_pathv; + const char * const *matches = glob_info.gl_pathv; - // FIXME -- we shouldn't have to check to see if - // a single match exists, but it seems that glob() won't - // check for us unless the pattern contains globbing - // characters. Hmm. + // FIXME -- we shouldn't have to check to see if + // a single match exists, but it seems that glob() won't + // check for us unless the pattern contains globbing + // characters. Hmm. - if (n > 1 - || (n == 1 - && single_match_exists (std::string (matches[0])))) - { - retval.resize (k+n); + if (n > 1 + || (n == 1 + && single_match_exists (std::string (matches[0])))) + { + retval.resize (k+n); - for (int j = 0; j < n; j++) - retval[k++] = matches[j]; - } + for (int j = 0; j < n; j++) + retval[k++] = matches[j]; + } - globfree (&glob_info); - } - } + globfree (&glob_info); + } + } } return retval.sort ();
--- a/liboctave/oct-group.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-group.cc Thu Feb 11 12:23:32 2010 -0500 @@ -197,17 +197,17 @@ int k = 0; while (*tmp++) - k++; + k++; if (k > 0) - { - tmp = gr->gr_mem; + { + tmp = gr->gr_mem; - gr_mem.resize (k); + gr_mem.resize (k); - for (int i = 0; i < k; i++) - gr_mem[i] = tmp[i]; - } + for (int i = 0; i < k; i++) + gr_mem[i] = tmp[i]; + } valid = true; }
--- a/liboctave/oct-inttypes.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-inttypes.cc Thu Feb 11 12:23:32 2010 -0500 @@ -552,15 +552,15 @@ b_val -= 1; while (b_val != 0) - { - if (b_val & 1) - retval = retval * a_val; + { + if (b_val & 1) + retval = retval * a_val; - b_val = b_val >> 1; + b_val = b_val >> 1; - if (b_val) - a_val = a_val * a_val; - } + if (b_val) + a_val = a_val * a_val; + } } return retval;
--- a/liboctave/oct-md5.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-md5.cc Thu Feb 11 12:23:32 2010 -0500 @@ -53,7 +53,7 @@ return oct_md5_result_to_str (buf); } - + std::string oct_md5_file (const std::string file) {
--- a/liboctave/oct-rand.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-rand.cc Thu Feb 11 12:23:32 2010 -0500 @@ -92,7 +92,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create octave_rand object!"); + ("unable to create octave_rand object!"); retval = false; } @@ -220,7 +220,7 @@ default: (*current_liboctave_error_handler) - ("rand: invalid distribution ID = %d", current_distribution); + ("rand: invalid distribution ID = %d", current_distribution); break; } @@ -256,7 +256,7 @@ default: (*current_liboctave_error_handler) - ("rand: invalid distribution ID = %d", id); + ("rand: invalid distribution ID = %d", id); break; } } @@ -310,72 +310,72 @@ if (use_old_generators) { switch (current_distribution) - { - case uniform_dist: - F77_FUNC (dgenunf, DGENUNF) (0.0, 1.0, retval); - break; + { + case uniform_dist: + F77_FUNC (dgenunf, DGENUNF) (0.0, 1.0, retval); + break; - case normal_dist: - F77_FUNC (dgennor, DGENNOR) (0.0, 1.0, retval); - break; + case normal_dist: + F77_FUNC (dgennor, DGENNOR) (0.0, 1.0, retval); + break; - case expon_dist: - F77_FUNC (dgenexp, DGENEXP) (1.0, retval); - break; + case expon_dist: + F77_FUNC (dgenexp, DGENEXP) (1.0, retval); + break; - case poisson_dist: - if (a < 0.0 || xisnan(a) || xisinf(a)) - retval = octave_NaN; - else - { - // workaround bug in ignpoi, by calling with different Mu - F77_FUNC (dignpoi, DIGNPOI) (a + 1, retval); - F77_FUNC (dignpoi, DIGNPOI) (a, retval); - } - break; + case poisson_dist: + if (a < 0.0 || xisnan(a) || xisinf(a)) + retval = octave_NaN; + else + { + // workaround bug in ignpoi, by calling with different Mu + F77_FUNC (dignpoi, DIGNPOI) (a + 1, retval); + F77_FUNC (dignpoi, DIGNPOI) (a, retval); + } + break; - case gamma_dist: - if (a <= 0.0 || xisnan(a) || xisinf(a)) - retval = octave_NaN; - else - F77_FUNC (dgengam, DGENGAM) (1.0, a, retval); - break; + case gamma_dist: + if (a <= 0.0 || xisnan(a) || xisinf(a)) + retval = octave_NaN; + else + F77_FUNC (dgengam, DGENGAM) (1.0, a, retval); + break; - default: - (*current_liboctave_error_handler) - ("rand: invalid distribution ID = %d", current_distribution); - break; - } + default: + (*current_liboctave_error_handler) + ("rand: invalid distribution ID = %d", current_distribution); + break; + } } else { switch (current_distribution) - { - case uniform_dist: - retval = oct_randu (); - break; + { + case uniform_dist: + retval = oct_randu (); + break; - case normal_dist: - retval = oct_randn (); - break; + case normal_dist: + retval = oct_randn (); + break; - case expon_dist: - retval = oct_rande (); - break; + case expon_dist: + retval = oct_rande (); + break; - case poisson_dist: - retval = oct_randp (a); - break; + case poisson_dist: + retval = oct_randp (a); + break; - case gamma_dist: - retval = oct_randg (a); - break; + case gamma_dist: + retval = oct_randg (a); + break; - default: - (*current_liboctave_error_handler) - ("rand: invalid distribution ID = %d", current_distribution); - break; - } + default: + (*current_liboctave_error_handler) + ("rand: invalid distribution ID = %d", current_distribution); + break; + } save_state (); } @@ -393,7 +393,7 @@ retval.clear (n, m); if (n > 0 && m > 0) - fill (retval.capacity(), retval.fortran_vec(), a); + fill (retval.capacity(), retval.fortran_vec(), a); } else (*current_liboctave_error_handler) ("rand: invalid negative argument"); @@ -561,11 +561,11 @@ { \ double val; \ for (volatile octave_idx_type i = 0; i < len; i++) \ - { \ - octave_quit (); \ - RAND_FUNC (val); \ - v[i] = val; \ - } \ + { \ + octave_quit (); \ + RAND_FUNC (val); \ + v[i] = val; \ + } \ } \ while (0) @@ -579,77 +579,77 @@ { case uniform_dist: if (use_old_generators) - { + { #define RAND_FUNC(x) F77_FUNC (dgenunf, DGENUNF) (0.0, 1.0, x) - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - } + } else - oct_fill_randu (len, v); + oct_fill_randu (len, v); break; case normal_dist: if (use_old_generators) - { + { #define RAND_FUNC(x) F77_FUNC (dgennor, DGENNOR) (0.0, 1.0, x) - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - } + } else - oct_fill_randn (len, v); + oct_fill_randn (len, v); break; case expon_dist: if (use_old_generators) - { + { #define RAND_FUNC(x) F77_FUNC (dgenexp, DGENEXP) (1.0, x) - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - } + } else - oct_fill_rande (len, v); + oct_fill_rande (len, v); break; case poisson_dist: if (use_old_generators) - { - if (a < 0.0 || xisnan(a) || xisinf(a)) + { + if (a < 0.0 || xisnan(a) || xisinf(a)) #define RAND_FUNC(x) x = octave_NaN; - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - else - { - // workaround bug in ignpoi, by calling with different Mu - double tmp; - F77_FUNC (dignpoi, DIGNPOI) (a + 1, tmp); + else + { + // workaround bug in ignpoi, by calling with different Mu + double tmp; + F77_FUNC (dignpoi, DIGNPOI) (a + 1, tmp); #define RAND_FUNC(x) F77_FUNC (dignpoi, DIGNPOI) (a, x) - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - } - } + } + } else - oct_fill_randp (a, len, v); + oct_fill_randp (a, len, v); break; case gamma_dist: if (use_old_generators) - { - if (a <= 0.0 || xisnan(a) || xisinf(a)) + { + if (a <= 0.0 || xisnan(a) || xisinf(a)) #define RAND_FUNC(x) x = octave_NaN; - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - else + else #define RAND_FUNC(x) F77_FUNC (dgengam, DGENGAM) (1.0, a, x) - MAKE_RAND (len); + MAKE_RAND (len); #undef RAND_FUNC - } + } else - oct_fill_randg (a, len, v); + oct_fill_randg (a, len, v); break; default: (*current_liboctave_error_handler) - ("rand: invalid distribution ID = %d", current_distribution); + ("rand: invalid distribution ID = %d", current_distribution); break; }
--- a/liboctave/oct-shlib.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-shlib.cc Thu Feb 11 12:23:32 2010 -0500 @@ -217,7 +217,7 @@ void * octave_dlopen_shlib::search (const std::string& name, - octave_shlib::name_mangler mangler) + octave_shlib::name_mangler mangler) { void *function = 0; @@ -226,7 +226,7 @@ std::string sym_name = name; if (mangler) - sym_name = mangler (name); + sym_name = mangler (name); function = dlsym (library, sym_name.c_str ()); } @@ -285,7 +285,7 @@ void * octave_shl_load_shlib::search (const std::string& name, - octave_shlib::name_mangler mangler) + octave_shlib::name_mangler mangler) { void *function = 0; @@ -294,10 +294,10 @@ std::string sym_name = name; if (mangler) - sym_name = mangler (name); - + sym_name = mangler (name); + int status = shl_findsym (&library, sym_name.c_str (), - TYPE_UNDEFINED, &function); + TYPE_UNDEFINED, &function); } else (*current_liboctave_error_handler) @@ -378,7 +378,7 @@ void * octave_w32_shlib::search (const std::string& name, - octave_shlib::name_mangler mangler) + octave_shlib::name_mangler mangler) { void *function = 0; @@ -387,7 +387,7 @@ std::string sym_name = name; if (mangler) - sym_name = mangler (name); + sym_name = mangler (name); function = octave_w32_library_search (handle, sym_name.c_str ()); } @@ -452,7 +452,7 @@ errstr = "unspecified error"; (*current_liboctave_error_handler) - ("%s: %s", file.c_str (), errstr); + ("%s: %s", file.c_str (), errstr); } } else @@ -475,7 +475,7 @@ void * octave_dyld_shlib::search (const std::string& name, - octave_shlib::name_mangler mangler) + octave_shlib::name_mangler mangler) { void *function = 0; @@ -484,14 +484,14 @@ std::string sym_name = name; if (mangler) - sym_name = mangler (name); + sym_name = mangler (name); NSSymbol symbol = NSLookupSymbolInModule (handle, sym_name.c_str ()); if (symbol) - { - function = NSAddressOfSymbol (symbol); - } + { + function = NSAddressOfSymbol (symbol); + } } else (*current_liboctave_error_handler)
--- a/liboctave/oct-sort.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-sort.cc Thu Feb 11 12:23:32 2010 -0500 @@ -164,21 +164,21 @@ * The second is vacuously true at the start. */ do - { - octave_idx_type p = l + ((r - l) >> 1); - if (comp (pivot, data[p])) - r = p; - else - l = p+1; - } + { + octave_idx_type p = l + ((r - l) >> 1); + if (comp (pivot, data[p])) + r = p; + else + l = p+1; + } while (l < r); /* The invariants still hold, so pivot >= all in [lo, l) and - pivot < all in [l, start), so pivot belongs at l. Note - that if there are elements equal to pivot, l points to the - first slot after them -- that's why this sort is stable. - Slide over to make room. - Caution: using memmove is much slower under MSVC 5; - we're not usually moving many slots. */ + pivot < all in [l, start), so pivot belongs at l. Note + that if there are elements equal to pivot, l points to the + first slot after them -- that's why this sort is stable. + Slide over to make room. + Caution: using memmove is much slower under MSVC 5; + we're not usually moving many slots. */ // NOTE: using swap and going upwards appears to be faster. for (octave_idx_type p = l; p < start; p++) std::swap (pivot, data[p]); @@ -208,21 +208,21 @@ * The second is vacuously true at the start. */ do - { - octave_idx_type p = l + ((r - l) >> 1); - if (comp (pivot, data[p])) - r = p; - else - l = p+1; - } + { + octave_idx_type p = l + ((r - l) >> 1); + if (comp (pivot, data[p])) + r = p; + else + l = p+1; + } while (l < r); /* The invariants still hold, so pivot >= all in [lo, l) and - pivot < all in [l, start), so pivot belongs at l. Note - that if there are elements equal to pivot, l points to the - first slot after them -- that's why this sort is stable. - Slide over to make room. - Caution: using memmove is much slower under MSVC 5; - we're not usually moving many slots. */ + pivot < all in [l, start), so pivot belongs at l. Note + that if there are elements equal to pivot, l points to the + first slot after them -- that's why this sort is stable. + Slide over to make room. + Caution: using memmove is much slower under MSVC 5; + we're not usually moving many slots. */ // NOTE: using swap and going upwards appears to be faster. for (octave_idx_type p = l; p < start; p++) std::swap (pivot, data[p]); @@ -273,20 +273,20 @@ { descending = true; for (lo = lo+1; lo < hi; ++lo, ++n) - { - if (comp (*lo, *(lo-1))) - ; - else - break; - } + { + if (comp (*lo, *(lo-1))) + ; + else + break; + } } else { for (lo = lo+1; lo < hi; ++lo, ++n) - { - if (comp (*lo, *(lo-1))) - break; - } + { + if (comp (*lo, *(lo-1))) + break; + } } return n; @@ -331,21 +331,21 @@ /* a[hint] < key -- gallop right, until * a[hint + lastofs] < key <= a[hint + ofs] */ - const octave_idx_type maxofs = n - hint; /* &a[n-1] is highest */ + const octave_idx_type maxofs = n - hint; /* &a[n-1] is highest */ while (ofs < maxofs) - { - if (comp (a[ofs], key)) - { - lastofs = ofs; - ofs = (ofs << 1) + 1; - if (ofs <= 0) /* int overflow */ - ofs = maxofs; - } - else /* key <= a[hint + ofs] */ - break; - } + { + if (comp (a[ofs], key)) + { + lastofs = ofs; + ofs = (ofs << 1) + 1; + if (ofs <= 0) /* int overflow */ + ofs = maxofs; + } + else /* key <= a[hint + ofs] */ + break; + } if (ofs > maxofs) - ofs = maxofs; + ofs = maxofs; /* Translate back to offsets relative to &a[0]. */ lastofs += hint; ofs += hint; @@ -355,19 +355,19 @@ /* key <= a[hint] -- gallop left, until * a[hint - ofs] < key <= a[hint - lastofs] */ - const octave_idx_type maxofs = hint + 1; /* &a[0] is lowest */ + const octave_idx_type maxofs = hint + 1; /* &a[0] is lowest */ while (ofs < maxofs) - { - if (comp (*(a-ofs), key)) - break; - /* key <= a[hint - ofs] */ - lastofs = ofs; - ofs = (ofs << 1) + 1; - if (ofs <= 0) /* int overflow */ - ofs = maxofs; - } + { + if (comp (*(a-ofs), key)) + break; + /* key <= a[hint - ofs] */ + lastofs = ofs; + ofs = (ofs << 1) + 1; + if (ofs <= 0) /* int overflow */ + ofs = maxofs; + } if (ofs > maxofs) - ofs = maxofs; + ofs = maxofs; /* Translate back to positive offsets relative to &a[0]. */ k = lastofs; lastofs = hint - ofs; @@ -385,9 +385,9 @@ octave_idx_type m = lastofs + ((ofs - lastofs) >> 1); if (comp (a[m], key)) - lastofs = m+1; /* a[m] < key */ + lastofs = m+1; /* a[m] < key */ else - ofs = m; /* key <= a[m] */ + ofs = m; /* key <= a[m] */ } return ofs; @@ -425,21 +425,21 @@ /* key < a[hint] -- gallop left, until * a[hint - ofs] <= key < a[hint - lastofs] */ - const octave_idx_type maxofs = hint + 1; /* &a[0] is lowest */ + const octave_idx_type maxofs = hint + 1; /* &a[0] is lowest */ while (ofs < maxofs) - { - if (comp (key, *(a-ofs))) - { - lastofs = ofs; - ofs = (ofs << 1) + 1; - if (ofs <= 0) /* int overflow */ - ofs = maxofs; - } - else /* a[hint - ofs] <= key */ - break; - } + { + if (comp (key, *(a-ofs))) + { + lastofs = ofs; + ofs = (ofs << 1) + 1; + if (ofs <= 0) /* int overflow */ + ofs = maxofs; + } + else /* a[hint - ofs] <= key */ + break; + } if (ofs > maxofs) - ofs = maxofs; + ofs = maxofs; /* Translate back to positive offsets relative to &a[0]. */ k = lastofs; lastofs = hint - ofs; @@ -450,19 +450,19 @@ /* a[hint] <= key -- gallop right, until * a[hint + lastofs] <= key < a[hint + ofs] */ - const octave_idx_type maxofs = n - hint; /* &a[n-1] is highest */ + const octave_idx_type maxofs = n - hint; /* &a[n-1] is highest */ while (ofs < maxofs) - { - if (comp (key, a[ofs])) - break; - /* a[hint + ofs] <= key */ - lastofs = ofs; - ofs = (ofs << 1) + 1; - if (ofs <= 0) /* int overflow */ - ofs = maxofs; - } + { + if (comp (key, a[ofs])) + break; + /* a[hint + ofs] <= key */ + lastofs = ofs; + ofs = (ofs << 1) + 1; + if (ofs <= 0) /* int overflow */ + ofs = maxofs; + } if (ofs > maxofs) - ofs = maxofs; + ofs = maxofs; /* Translate back to offsets relative to &a[0]. */ lastofs += hint; ofs += hint; @@ -479,9 +479,9 @@ octave_idx_type m = lastofs + ((ofs - lastofs) >> 1); if (comp (key, a[m])) - ofs = m; /* key < a[m] */ + ofs = m; /* key < a[m] */ else - lastofs = m+1; /* a[m] <= key */ + lastofs = m+1; /* a[m] <= key */ } return ofs; @@ -579,7 +579,7 @@ { octave_idx_type k; T *dest; - int result = -1; /* guilty until proved innocent */ + int result = -1; /* guilty until proved innocent */ octave_idx_type min_gallop = ms->min_gallop; ms->getmem (na); @@ -597,41 +597,41 @@ for (;;) { - octave_idx_type acount = 0; /* # of times A won in a row */ - octave_idx_type bcount = 0; /* # of times B won in a row */ + octave_idx_type acount = 0; /* # of times A won in a row */ + octave_idx_type bcount = 0; /* # of times B won in a row */ /* Do the straightforward thing until (if ever) one run * appears to win consistently. */ for (;;) - { + { // FIXME: these loops are candidates for further optimizations. // Rather than testing everything in each cycle, it may be more // efficient to do it in hunks. - if (comp (*pb, *pa)) - { - *dest++ = *pb++; - ++bcount; - acount = 0; - --nb; - if (nb == 0) - goto Succeed; - if (bcount >= min_gallop) - break; - } - else - { - *dest++ = *pa++; - ++acount; - bcount = 0; - --na; - if (na == 1) - goto CopyB; - if (acount >= min_gallop) - break; - } - } + if (comp (*pb, *pa)) + { + *dest++ = *pb++; + ++bcount; + acount = 0; + --nb; + if (nb == 0) + goto Succeed; + if (bcount >= min_gallop) + break; + } + else + { + *dest++ = *pa++; + ++acount; + bcount = 0; + --na; + if (na == 1) + goto CopyB; + if (acount >= min_gallop) + break; + } + } /* One run is winning so consistently that galloping may * be a huge win. So try that, and continue galloping until @@ -640,52 +640,52 @@ */ ++min_gallop; do - { - min_gallop -= min_gallop > 1; - ms->min_gallop = min_gallop; - k = gallop_right (*pb, pa, na, 0, comp); - acount = k; - if (k) - { - if (k < 0) - goto Fail; + { + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + k = gallop_right (*pb, pa, na, 0, comp); + acount = k; + if (k) + { + if (k < 0) + goto Fail; dest = std::copy (pa, pa + k, dest); - pa += k; - na -= k; - if (na == 1) - goto CopyB; - /* na==0 is impossible now if the comparison - * function is consistent, but we can't assume - * that it is. - */ - if (na == 0) - goto Succeed; - } - *dest++ = *pb++; - --nb; - if (nb == 0) - goto Succeed; + pa += k; + na -= k; + if (na == 1) + goto CopyB; + /* na==0 is impossible now if the comparison + * function is consistent, but we can't assume + * that it is. + */ + if (na == 0) + goto Succeed; + } + *dest++ = *pb++; + --nb; + if (nb == 0) + goto Succeed; - k = gallop_left (*pa, pb, nb, 0, comp); - bcount = k; - if (k) - { - if (k < 0) - goto Fail; + k = gallop_left (*pa, pb, nb, 0, comp); + bcount = k; + if (k) + { + if (k < 0) + goto Fail; dest = std::copy (pb, pb + k, dest); - pb += k; - nb -= k; - if (nb == 0) - goto Succeed; - } - *dest++ = *pa++; - --na; - if (na == 1) - goto CopyB; - } + pb += k; + nb -= k; + if (nb == 0) + goto Succeed; + } + *dest++ = *pa++; + --na; + if (na == 1) + goto CopyB; + } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); - ++min_gallop; /* penalize it for leaving galloping mode */ + ++min_gallop; /* penalize it for leaving galloping mode */ ms->min_gallop = min_gallop; } @@ -715,7 +715,7 @@ octave_idx_type k; T *dest; octave_idx_type *idest; - int result = -1; /* guilty until proved innocent */ + int result = -1; /* guilty until proved innocent */ octave_idx_type min_gallop = ms->min_gallop; ms->getmemi (na); @@ -734,38 +734,38 @@ for (;;) { - octave_idx_type acount = 0; /* # of times A won in a row */ - octave_idx_type bcount = 0; /* # of times B won in a row */ + octave_idx_type acount = 0; /* # of times A won in a row */ + octave_idx_type bcount = 0; /* # of times B won in a row */ /* Do the straightforward thing until (if ever) one run * appears to win consistently. */ for (;;) - { + { - if (comp (*pb, *pa)) - { - *dest++ = *pb++; *idest++ = *ipb++; - ++bcount; - acount = 0; - --nb; - if (nb == 0) - goto Succeed; - if (bcount >= min_gallop) - break; - } - else - { - *dest++ = *pa++; *idest++ = *ipa++; - ++acount; - bcount = 0; - --na; - if (na == 1) - goto CopyB; - if (acount >= min_gallop) - break; - } - } + if (comp (*pb, *pa)) + { + *dest++ = *pb++; *idest++ = *ipb++; + ++bcount; + acount = 0; + --nb; + if (nb == 0) + goto Succeed; + if (bcount >= min_gallop) + break; + } + else + { + *dest++ = *pa++; *idest++ = *ipa++; + ++acount; + bcount = 0; + --na; + if (na == 1) + goto CopyB; + if (acount >= min_gallop) + break; + } + } /* One run is winning so consistently that galloping may * be a huge win. So try that, and continue galloping until @@ -774,54 +774,54 @@ */ ++min_gallop; do - { - min_gallop -= min_gallop > 1; - ms->min_gallop = min_gallop; - k = gallop_right (*pb, pa, na, 0, comp); - acount = k; - if (k) - { - if (k < 0) - goto Fail; + { + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + k = gallop_right (*pb, pa, na, 0, comp); + acount = k; + if (k) + { + if (k < 0) + goto Fail; dest = std::copy (pa, pa + k, dest); idest = std::copy (ipa, ipa + k, idest); - pa += k; ipa += k; - na -= k; - if (na == 1) - goto CopyB; - /* na==0 is impossible now if the comparison - * function is consistent, but we can't assume - * that it is. - */ - if (na == 0) - goto Succeed; - } - *dest++ = *pb++; *idest++ = *ipb++; - --nb; - if (nb == 0) - goto Succeed; + pa += k; ipa += k; + na -= k; + if (na == 1) + goto CopyB; + /* na==0 is impossible now if the comparison + * function is consistent, but we can't assume + * that it is. + */ + if (na == 0) + goto Succeed; + } + *dest++ = *pb++; *idest++ = *ipb++; + --nb; + if (nb == 0) + goto Succeed; - k = gallop_left (*pa, pb, nb, 0, comp); - bcount = k; - if (k) - { - if (k < 0) - goto Fail; + k = gallop_left (*pa, pb, nb, 0, comp); + bcount = k; + if (k) + { + if (k < 0) + goto Fail; dest = std::copy (pb, pb + k, dest); idest = std::copy (ipb, ipb + k, idest); - pb += k; ipb += k; - nb -= k; - if (nb == 0) - goto Succeed; - } - *dest++ = *pa++; *idest++ = *ipa++; - --na; - if (na == 1) - goto CopyB; - } + pb += k; ipb += k; + nb -= k; + if (nb == 0) + goto Succeed; + } + *dest++ = *pa++; *idest++ = *ipa++; + --na; + if (na == 1) + goto CopyB; + } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); - ++min_gallop; /* penalize it for leaving galloping mode */ + ++min_gallop; /* penalize it for leaving galloping mode */ ms->min_gallop = min_gallop; } @@ -861,7 +861,7 @@ { octave_idx_type k; T *dest; - int result = -1; /* guilty until proved innocent */ + int result = -1; /* guilty until proved innocent */ T *basea, *baseb; octave_idx_type min_gallop = ms->min_gallop; @@ -883,37 +883,37 @@ for (;;) { - octave_idx_type acount = 0; /* # of times A won in a row */ - octave_idx_type bcount = 0; /* # of times B won in a row */ + octave_idx_type acount = 0; /* # of times A won in a row */ + octave_idx_type bcount = 0; /* # of times B won in a row */ /* Do the straightforward thing until (if ever) one run * appears to win consistently. */ for (;;) - { - if (comp (*pb, *pa)) - { - *dest-- = *pa--; - ++acount; - bcount = 0; - --na; - if (na == 0) - goto Succeed; - if (acount >= min_gallop) - break; - } - else - { - *dest-- = *pb--; - ++bcount; - acount = 0; - --nb; - if (nb == 1) - goto CopyA; - if (bcount >= min_gallop) - break; - } - } + { + if (comp (*pb, *pa)) + { + *dest-- = *pa--; + ++acount; + bcount = 0; + --na; + if (na == 0) + goto Succeed; + if (acount >= min_gallop) + break; + } + else + { + *dest-- = *pb--; + ++bcount; + acount = 0; + --nb; + if (nb == 1) + goto CopyA; + if (bcount >= min_gallop) + break; + } + } /* One run is winning so consistently that galloping may * be a huge win. So try that, and continue galloping until @@ -922,53 +922,53 @@ */ ++min_gallop; do - { - min_gallop -= min_gallop > 1; - ms->min_gallop = min_gallop; - k = gallop_right (*pb, basea, na, na-1, comp); - if (k < 0) - goto Fail; - k = na - k; - acount = k; - if (k) - { + { + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + k = gallop_right (*pb, basea, na, na-1, comp); + if (k < 0) + goto Fail; + k = na - k; + acount = k; + if (k) + { dest = std::copy_backward (pa+1 - k, pa+1, dest+1) - 1; - pa -= k; - na -= k; - if (na == 0) - goto Succeed; - } - *dest-- = *pb--; - --nb; - if (nb == 1) - goto CopyA; + pa -= k; + na -= k; + if (na == 0) + goto Succeed; + } + *dest-- = *pb--; + --nb; + if (nb == 1) + goto CopyA; - k = gallop_left (*pa, baseb, nb, nb-1, comp); - if (k < 0) - goto Fail; - k = nb - k; - bcount = k; - if (k) - { - dest -= k; - pb -= k; + k = gallop_left (*pa, baseb, nb, nb-1, comp); + if (k < 0) + goto Fail; + k = nb - k; + bcount = k; + if (k) + { + dest -= k; + pb -= k; std::copy (pb+1, pb+1 + k, dest+1); - nb -= k; - if (nb == 1) - goto CopyA; - /* nb==0 is impossible now if the comparison - * function is consistent, but we can't assume - * that it is. - */ - if (nb == 0) - goto Succeed; - } - *dest-- = *pa--; - --na; - if (na == 0) - goto Succeed; - } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); - ++min_gallop; /* penalize it for leaving galloping mode */ + nb -= k; + if (nb == 1) + goto CopyA; + /* nb==0 is impossible now if the comparison + * function is consistent, but we can't assume + * that it is. + */ + if (nb == 0) + goto Succeed; + } + *dest-- = *pa--; + --na; + if (na == 0) + goto Succeed; + } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); + ++min_gallop; /* penalize it for leaving galloping mode */ ms->min_gallop = min_gallop; } @@ -999,7 +999,7 @@ octave_idx_type k; T *dest; octave_idx_type *idest; - int result = -1; /* guilty until proved innocent */ + int result = -1; /* guilty until proved innocent */ T *basea, *baseb; octave_idx_type *ibasea, *ibaseb; octave_idx_type min_gallop = ms->min_gallop; @@ -1024,37 +1024,37 @@ for (;;) { - octave_idx_type acount = 0; /* # of times A won in a row */ - octave_idx_type bcount = 0; /* # of times B won in a row */ + octave_idx_type acount = 0; /* # of times A won in a row */ + octave_idx_type bcount = 0; /* # of times B won in a row */ /* Do the straightforward thing until (if ever) one run * appears to win consistently. */ for (;;) - { - if (comp (*pb, *pa)) - { - *dest-- = *pa--; *idest-- = *ipa--; - ++acount; - bcount = 0; - --na; - if (na == 0) - goto Succeed; - if (acount >= min_gallop) - break; - } - else - { - *dest-- = *pb--; *idest-- = *ipb--; - ++bcount; - acount = 0; - --nb; - if (nb == 1) - goto CopyA; - if (bcount >= min_gallop) - break; - } - } + { + if (comp (*pb, *pa)) + { + *dest-- = *pa--; *idest-- = *ipa--; + ++acount; + bcount = 0; + --na; + if (na == 0) + goto Succeed; + if (acount >= min_gallop) + break; + } + else + { + *dest-- = *pb--; *idest-- = *ipb--; + ++bcount; + acount = 0; + --nb; + if (nb == 1) + goto CopyA; + if (bcount >= min_gallop) + break; + } + } /* One run is winning so consistently that galloping may * be a huge win. So try that, and continue galloping until @@ -1063,55 +1063,55 @@ */ ++min_gallop; do - { - min_gallop -= min_gallop > 1; - ms->min_gallop = min_gallop; - k = gallop_right (*pb, basea, na, na-1, comp); - if (k < 0) - goto Fail; - k = na - k; - acount = k; - if (k) - { + { + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + k = gallop_right (*pb, basea, na, na-1, comp); + if (k < 0) + goto Fail; + k = na - k; + acount = k; + if (k) + { dest = std::copy_backward (pa+1 - k, pa+1, dest+1) - 1; idest = std::copy_backward (ipa+1 - k, ipa+1, idest+1) - 1; - pa -= k; ipa -= k; - na -= k; - if (na == 0) - goto Succeed; - } - *dest-- = *pb--; *idest-- = *ipb--; - --nb; - if (nb == 1) - goto CopyA; + pa -= k; ipa -= k; + na -= k; + if (na == 0) + goto Succeed; + } + *dest-- = *pb--; *idest-- = *ipb--; + --nb; + if (nb == 1) + goto CopyA; - k = gallop_left (*pa, baseb, nb, nb-1, comp); - if (k < 0) - goto Fail; - k = nb - k; - bcount = k; - if (k) - { - dest -= k; idest -= k; - pb -= k; ipb -= k; + k = gallop_left (*pa, baseb, nb, nb-1, comp); + if (k < 0) + goto Fail; + k = nb - k; + bcount = k; + if (k) + { + dest -= k; idest -= k; + pb -= k; ipb -= k; std::copy (pb+1, pb+1 + k, dest+1); std::copy (ipb+1, ipb+1 + k, idest+1); - nb -= k; - if (nb == 1) - goto CopyA; - /* nb==0 is impossible now if the comparison - * function is consistent, but we can't assume - * that it is. - */ - if (nb == 0) - goto Succeed; - } - *dest-- = *pa--; *idest-- = *ipa--; - --na; - if (na == 0) - goto Succeed; - } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); - ++min_gallop; /* penalize it for leaving galloping mode */ + nb -= k; + if (nb == 1) + goto CopyA; + /* nb==0 is impossible now if the comparison + * function is consistent, but we can't assume + * that it is. + */ + if (nb == 0) + goto Succeed; + } + *dest-- = *pa--; *idest-- = *ipa--; + --na; + if (na == 0) + goto Succeed; + } while (acount >= MIN_GALLOP || bcount >= MIN_GALLOP); + ++min_gallop; /* penalize it for leaving galloping mode */ ms->min_gallop = min_gallop; } @@ -1265,19 +1265,19 @@ { octave_idx_type n = ms->n - 2; if (n > 0 && p[n-1].len <= p[n].len + p[n+1].len) - { - if (p[n-1].len < p[n+1].len) - --n; - if (merge_at (n, data, comp) < 0) - return -1; - } + { + if (p[n-1].len < p[n+1].len) + --n; + if (merge_at (n, data, comp) < 0) + return -1; + } else if (p[n].len <= p[n+1].len) - { - if (merge_at (n, data, comp) < 0) - return -1; - } + { + if (merge_at (n, data, comp) < 0) + return -1; + } else - break; + break; } return 0; @@ -1294,19 +1294,19 @@ { octave_idx_type n = ms->n - 2; if (n > 0 && p[n-1].len <= p[n].len + p[n+1].len) - { - if (p[n-1].len < p[n+1].len) - --n; - if (merge_at (n, data, idx, comp) < 0) - return -1; - } + { + if (p[n-1].len < p[n+1].len) + --n; + if (merge_at (n, data, idx, comp) < 0) + return -1; + } else if (p[n].len <= p[n+1].len) - { - if (merge_at (n, data, idx, comp) < 0) - return -1; - } + { + if (merge_at (n, data, idx, comp) < 0) + return -1; + } else - break; + break; } return 0; @@ -1328,9 +1328,9 @@ { octave_idx_type n = ms->n - 2; if (n > 0 && p[n-1].len < p[n+1].len) - --n; + --n; if (merge_at (n, data, comp) < 0) - return -1; + return -1; } return 0; @@ -1347,9 +1347,9 @@ { octave_idx_type n = ms->n - 2; if (n > 0 && p[n-1].len < p[n+1].len) - --n; + --n; if (merge_at (n, data, idx, comp) < 0) - return -1; + return -1; } return 0; @@ -1369,7 +1369,7 @@ octave_idx_type octave_sort<T>::merge_compute_minrun (octave_idx_type n) { - octave_idx_type r = 0; /* becomes 1 if any 1 bits are shifted off */ + octave_idx_type r = 0; /* becomes 1 if any 1 bits are shifted off */ while (n >= 64) { @@ -1401,34 +1401,34 @@ */ octave_idx_type minrun = merge_compute_minrun (nremaining); do - { - bool descending; - octave_idx_type n; + { + bool descending; + octave_idx_type n; - /* Identify next run. */ - n = count_run (data + lo, nremaining, descending, comp); - if (n < 0) - goto fail; - if (descending) + /* Identify next run. */ + n = count_run (data + lo, nremaining, descending, comp); + if (n < 0) + goto fail; + if (descending) std::reverse (data + lo, data + lo + n); - /* If short, extend to min(minrun, nremaining). */ - if (n < minrun) - { - const octave_idx_type force = nremaining <= minrun ? nremaining : minrun; - binarysort (data + lo, force, n, comp); - n = force; - } - /* Push run onto pending-runs stack, and maybe merge. */ - assert (ms->n < MAX_MERGE_PENDING); - ms->pending[ms->n].base = lo; - ms->pending[ms->n].len = n; - ms->n++; - if (merge_collapse (data, comp) < 0) - goto fail; - /* Advance to find next run. */ - lo += n; - nremaining -= n; - } + /* If short, extend to min(minrun, nremaining). */ + if (n < minrun) + { + const octave_idx_type force = nremaining <= minrun ? nremaining : minrun; + binarysort (data + lo, force, n, comp); + n = force; + } + /* Push run onto pending-runs stack, and maybe merge. */ + assert (ms->n < MAX_MERGE_PENDING); + ms->pending[ms->n].base = lo; + ms->pending[ms->n].len = n; + ms->n++; + if (merge_collapse (data, comp) < 0) + goto fail; + /* Advance to find next run. */ + lo += n; + nremaining -= n; + } while (nremaining); merge_force_collapse (data, comp); @@ -1460,37 +1460,37 @@ */ octave_idx_type minrun = merge_compute_minrun (nremaining); do - { - bool descending; - octave_idx_type n; + { + bool descending; + octave_idx_type n; - /* Identify next run. */ - n = count_run (data + lo, nremaining, descending, comp); - if (n < 0) - goto fail; - if (descending) + /* Identify next run. */ + n = count_run (data + lo, nremaining, descending, comp); + if (n < 0) + goto fail; + if (descending) { std::reverse (data + lo, data + lo + n); std::reverse (idx + lo, idx + lo + n); } - /* If short, extend to min(minrun, nremaining). */ - if (n < minrun) - { - const octave_idx_type force = nremaining <= minrun ? nremaining : minrun; - binarysort (data + lo, idx + lo, force, n, comp); - n = force; - } - /* Push run onto pending-runs stack, and maybe merge. */ - assert (ms->n < MAX_MERGE_PENDING); - ms->pending[ms->n].base = lo; - ms->pending[ms->n].len = n; - ms->n++; - if (merge_collapse (data, idx, comp) < 0) - goto fail; - /* Advance to find next run. */ - lo += n; - nremaining -= n; - } + /* If short, extend to min(minrun, nremaining). */ + if (n < minrun) + { + const octave_idx_type force = nremaining <= minrun ? nremaining : minrun; + binarysort (data + lo, idx + lo, force, n, comp); + n = force; + } + /* Push run onto pending-runs stack, and maybe merge. */ + assert (ms->n < MAX_MERGE_PENDING); + ms->pending[ms->n].base = lo; + ms->pending[ms->n].len = n; + ms->n++; + if (merge_collapse (data, idx, comp) < 0) + goto fail; + /* Advance to find next run. */ + lo += n; + nremaining -= n; + } while (nremaining); merge_force_collapse (data, idx, comp); @@ -1941,7 +1941,7 @@ template <class T> bool octave_sort<T>::ascending_compare (typename ref_param<T>::type x, - typename ref_param<T>::type y) + typename ref_param<T>::type y) { return x < y; } @@ -1949,7 +1949,7 @@ template <class T> bool octave_sort<T>::descending_compare (typename ref_param<T>::type x, - typename ref_param<T>::type y) + typename ref_param<T>::type y) { return x > y; }
--- a/liboctave/oct-spparms.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-spparms.cc Thu Feb 11 12:23:32 2010 -0500 @@ -43,7 +43,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create octave_sparse_params object!"); + ("unable to create octave_sparse_params object!"); retval = false; } @@ -176,14 +176,14 @@ if (len > OCTAVE_SPARSE_CONTROLS_SIZE) { (*current_liboctave_error_handler) - ("octave_sparse_params::do_set_vals: too many values"); + ("octave_sparse_params::do_set_vals: too many values"); return false; } else { for (int i = 0; i < len; i++) - params(i) = vals(i); + params(i) = vals(i); return true; } @@ -195,10 +195,10 @@ for (int i = 0; i < OCTAVE_SPARSE_CONTROLS_SIZE; i++) { if (keys (i) == key) - { - params(i) = val; - return true; - } + { + params(i) = val; + return true; + } } return false; @@ -210,7 +210,7 @@ for (int i = 0; i < OCTAVE_SPARSE_CONTROLS_SIZE; i++) { if (keys (i) == key) - return params(i); + return params(i); } return octave_NaN; @@ -218,7 +218,7 @@ void octave_sparse_params::do_print_info (std::ostream& os, - const std::string& prefix) const + const std::string& prefix) const { for (int i = 0; i < OCTAVE_SPARSE_CONTROLS_SIZE; i++) os << prefix << keys(i) << ": " << params(i) << "\n";
--- a/liboctave/oct-syscalls.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-syscalls.cc Thu Feb 11 12:23:32 2010 -0500 @@ -86,7 +86,7 @@ int octave_syscalls::execvp (const std::string& file, const string_vector& args, - std::string& msg) + std::string& msg) { msg = std::string (); @@ -273,7 +273,7 @@ pid_t octave_syscalls::waitpid (pid_t pid, int *status, int options, - std::string& msg) + std::string& msg) { pid_t retval = -1; msg = std::string (); @@ -358,9 +358,9 @@ msg = "popen2: process creation failed -- " + msg; else if (pid == 0) { - std::string child_msg; + std::string child_msg; - interactive = false; + interactive = false; // Child process ::close (child_stdin[1]); @@ -380,10 +380,10 @@ } else child_msg = "popen2 (child): file handle duplication failed -- " + child_msg; - - (*current_liboctave_error_handler)(child_msg.c_str()); - - exit(0); + + (*current_liboctave_error_handler)(child_msg.c_str()); + + exit(0); } else {
--- a/liboctave/oct-time.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/oct-time.cc Thu Feb 11 12:23:32 2010 -0500 @@ -91,7 +91,7 @@ // // <snip> // -// If structure members are outside their legal interval, they +// If structure members are outside their legal interval, they // will be normalized (so that, e.g., 40 October is changed into // 9 November). // @@ -104,7 +104,7 @@ { \ if (v < lo || v > hi) \ (*current_liboctave_error_handler) \ - ("invalid value specified for " #f); \ + ("invalid value specified for " #f); \ \ tm_ ## f = v; \ \ @@ -174,15 +174,15 @@ size_t chars_written = 0; while (chars_written == 0) - { - delete [] buf; - buf = new char[bufsize]; - buf[0] = '\0'; + { + delete [] buf; + buf = new char[bufsize]; + buf[0] = '\0'; - chars_written = nstrftime (buf, bufsize, fmt_str, &t, 0, 0); + chars_written = nstrftime (buf, bufsize, fmt_str, &t, 0, 0); - bufsize *= 2; - } + bufsize *= 2; + } #if defined (HAVE_STRUCT_TM_TM_ZONE) delete [] ps;
--- a/liboctave/pathsearch.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/pathsearch.cc Thu Feb 11 12:23:32 2010 -0500 @@ -53,7 +53,7 @@ if (! instance) { (*current_liboctave_error_handler) - ("unable to create dir_path::static_members object!"); + ("unable to create dir_path::static_members object!"); retval = false; } @@ -82,29 +82,29 @@ retval.resize (len); for (int i = 0; i < len; i++) - { - str_llist_type *elt_dirs = kpse_element_dirs (pv[i]); + { + str_llist_type *elt_dirs = kpse_element_dirs (pv[i]); - if (elt_dirs) - { - str_llist_elt_type *dir; + if (elt_dirs) + { + str_llist_elt_type *dir; - for (dir = *elt_dirs; dir; dir = STR_LLIST_NEXT (*dir)) - { - const std::string elt_dir = STR_LLIST (*dir); + for (dir = *elt_dirs; dir; dir = STR_LLIST_NEXT (*dir)) + { + const std::string elt_dir = STR_LLIST (*dir); - if (! elt_dir.empty ()) - { - if (count == nmax) - nmax *= 2; + if (! elt_dir.empty ()) + { + if (count == nmax) + nmax *= 2; - retval.resize (nmax); + retval.resize (nmax); - retval[count++] = elt_dir; - } - } - } - } + retval[count++] = elt_dir; + } + } + } + } retval.resize (count); } @@ -148,13 +148,13 @@ std::string val = octave_env::getenv ("KPATHSEA_DEBUG"); if (! val.empty ()) - kpathsea_debug |= atoi (val.c_str ()); + kpathsea_debug |= atoi (val.c_str ()); octave_kpathsea_initialized = true; } p = kpse_path_expand (p_default.empty () - ? p_orig : kpse_expand_default (p_orig, p_default)); + ? p_orig : kpse_expand_default (p_orig, p_default)); int count = 0; for (kpse_path_iterator pi (p); pi != std::string::npos; pi++)
--- a/liboctave/regex-match.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/regex-match.cc Thu Feb 11 12:23:32 2010 -0500 @@ -39,7 +39,7 @@ { #if HAVE_REGEX for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); + regfree (compiled +i); delete [] compiled; #endif pat = gm.pat; @@ -96,10 +96,10 @@ for (i = 0; i < npat; i++) { err = regcomp (compiled + i, pat(i).c_str (), - (REG_NOSUB | REG_EXTENDED | - (case_insen ? REG_ICASE : 0))); + (REG_NOSUB | REG_EXTENDED | + (case_insen ? REG_ICASE : 0))); if (err) - break; + break; } if (err) @@ -108,10 +108,10 @@ OCTAVE_LOCAL_BUFFER (char, errmsg, len); regerror(err, compiled + i, errmsg, len); (*current_liboctave_error_handler) ("%s in pattern (%s)", errmsg, - pat(i).c_str()); + pat(i).c_str()); for (int j = 0; j < i + 1; j++) - regfree (compiled + j); + regfree (compiled + j); } #else (*current_liboctave_error_handler)
--- a/liboctave/sparse-base-chol.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/sparse-base-chol.cc Thu Feb 11 12:23:32 2010 -0500 @@ -60,18 +60,18 @@ pend = Sp [k+1]; Sp [k] = pdest; for (; p < pend; p++) - { - sik = Sx [p]; - if (CHOLMOD_IS_NONZERO (sik)) - { - if (p != pdest) - { - Si [pdest] = Si [p]; - Sx [pdest] = sik; - } - pdest++; - } - } + { + sik = Sx [p]; + if (CHOLMOD_IS_NONZERO (sik)) + { + if (p != pdest) + { + Si [pdest] = Si [p]; + Sx [pdest] = sik; + } + pdest++; + } + } } Sp [ncol] = pdest; } @@ -90,7 +90,7 @@ if (a_nr != a_nc) { (*current_liboctave_error_handler) - ("SparseCHOL requires square matrix"); + ("SparseCHOL requires square matrix"); return -1; } @@ -183,26 +183,26 @@ END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; if (minor_p > 0 && minor_p < a_nr) - { - size_t n1 = a_nr + 1; - Lsparse->p = CHOLMOD_NAME(realloc) (minor_p+1, - sizeof(octave_idx_type), - Lsparse->p, &n1, cm); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(reallocate_sparse) - (static_cast<octave_idx_type *>(Lsparse->p)[minor_p], Lsparse, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - Lsparse->ncol = minor_p; - } + { + size_t n1 = a_nr + 1; + Lsparse->p = CHOLMOD_NAME(realloc) (minor_p+1, + sizeof(octave_idx_type), + Lsparse->p, &n1, cm); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(reallocate_sparse) + (static_cast<octave_idx_type *>(Lsparse->p)[minor_p], Lsparse, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + Lsparse->ncol = minor_p; + } drop_zeros (Lsparse); if (! natural) - { - perms.resize (a_nr); - for (octave_idx_type i = 0; i < a_nr; i++) - perms(i) = static_cast<octave_idx_type *>(Lfactor->Perm)[i]; - } + { + perms.resize (a_nr); + for (octave_idx_type i = 0; i < a_nr; i++) + perms(i) = static_cast<octave_idx_type *>(Lfactor->Perm)[i]; + } static char tmp[] = " ";
--- a/liboctave/sparse-base-lu.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/sparse-base-lu.cc Thu Feb 11 12:23:32 2010 -0500 @@ -42,20 +42,20 @@ for (octave_idx_type j = 0; j < nc; j++) { for (octave_idx_type i = Ufact.cidx (j); i < Ufact.cidx(j + 1); i++) - { - Yout.xridx (ii) = Ufact.ridx(i); - Yout.xdata (ii++) = Ufact.data(i); - } + { + Yout.xridx (ii) = Ufact.ridx(i); + Yout.xdata (ii++) = Ufact.data(i); + } if (j < rcmin) - { - // Note the +1 skips the 1.0 on the diagonal - for (octave_idx_type i = Lfact.cidx (j) + 1; - i < Lfact.cidx(j +1); i++) - { - Yout.xridx (ii) = Lfact.ridx(i); - Yout.xdata (ii++) = Lfact.data(i); - } - } + { + // Note the +1 skips the 1.0 on the diagonal + for (octave_idx_type i = Lfact.cidx (j) + 1; + i < Lfact.cidx(j +1); i++) + { + Yout.xridx (ii) = Lfact.ridx(i); + Yout.xdata (ii++) = Lfact.data(i); + } + } Yout.xcidx(j + 1) = ii; }
--- a/liboctave/sparse-dmsolve.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/sparse-dmsolve.cc Thu Feb 11 12:23:32 2010 -0500 @@ -37,10 +37,10 @@ template <class T> static MSparse<T> dmsolve_extract (const MSparse<T> &A, const octave_idx_type *Pinv, - const octave_idx_type *Q, octave_idx_type rst, - octave_idx_type rend, octave_idx_type cst, - octave_idx_type cend, octave_idx_type maxnz = -1, - bool lazy = false) + const octave_idx_type *Q, octave_idx_type rst, + octave_idx_type rend, octave_idx_type cst, + octave_idx_type cend, octave_idx_type maxnz = -1, + bool lazy = false) { octave_idx_type nz = (rend - rst) * (cend - cst); maxnz = (maxnz < 0 ? A.nnz () : maxnz); @@ -53,20 +53,20 @@ { nz = 0; for (octave_idx_type j = cst ; j < cend ; j++) - { - octave_idx_type qq = (Q ? Q [j] : j); - B.xcidx (j - cst) = nz; - for (octave_idx_type p = A.cidx(qq) ; p < A.cidx (qq+1) ; p++) - { - octave_quit (); - octave_idx_type r = (Pinv ? Pinv [A.ridx (p)] : A.ridx (p)); - if (r >= rst && r < rend) - { - B.xdata (nz) = A.data (p); - B.xridx (nz++) = r - rst ; - } - } - } + { + octave_idx_type qq = (Q ? Q [j] : j); + B.xcidx (j - cst) = nz; + for (octave_idx_type p = A.cidx(qq) ; p < A.cidx (qq+1) ; p++) + { + octave_quit (); + octave_idx_type r = (Pinv ? Pinv [A.ridx (p)] : A.ridx (p)); + if (r >= rst && r < rend) + { + B.xdata (nz) = A.data (p); + B.xridx (nz++) = r - rst ; + } + } + } B.xcidx (cend - cst) = nz ; } else @@ -76,23 +76,23 @@ octave_idx_type *ri = B.xridx(); nz = 0; for (octave_idx_type j = cst ; j < cend ; j++) - { - octave_idx_type qq = (Q ? Q [j] : j); - B.xcidx (j - cst) = nz; - for (octave_idx_type p = A.cidx(qq) ; p < A.cidx (qq+1) ; p++) - { - octave_quit (); - octave_idx_type r = (Pinv ? Pinv [A.ridx (p)] : A.ridx (p)); - if (r >= rst && r < rend) - { - X [r-rst] = A.data (p); - B.xridx (nz++) = r - rst ; - } - } - sort.sort (ri + B.xcidx (j - cst), nz - B.xcidx (j - cst)); - for (octave_idx_type p = B.cidx (j - cst); p < nz; p++) - B.xdata (p) = X [B.xridx (p)]; - } + { + octave_idx_type qq = (Q ? Q [j] : j); + B.xcidx (j - cst) = nz; + for (octave_idx_type p = A.cidx(qq) ; p < A.cidx (qq+1) ; p++) + { + octave_quit (); + octave_idx_type r = (Pinv ? Pinv [A.ridx (p)] : A.ridx (p)); + if (r >= rst && r < rend) + { + X [r-rst] = A.data (p); + B.xridx (nz++) = r - rst ; + } + } + sort.sort (ri + B.xcidx (j - cst), nz - B.xcidx (j - cst)); + for (octave_idx_type p = B.cidx (j - cst); p < nz; p++) + B.xdata (p) = X [B.xridx (p)]; + } B.xcidx (cend - cst) = nz ; } @@ -102,25 +102,25 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static MSparse<double> dmsolve_extract (const MSparse<double> &A, const octave_idx_type *Pinv, - const octave_idx_type *Q, octave_idx_type rst, - octave_idx_type rend, octave_idx_type cst, - octave_idx_type cend, octave_idx_type maxnz, - bool lazy); + const octave_idx_type *Q, octave_idx_type rst, + octave_idx_type rend, octave_idx_type cst, + octave_idx_type cend, octave_idx_type maxnz, + bool lazy); static MSparse<Complex> dmsolve_extract (const MSparse<Complex> &A, const octave_idx_type *Pinv, - const octave_idx_type *Q, octave_idx_type rst, - octave_idx_type rend, octave_idx_type cst, - octave_idx_type cend, octave_idx_type maxnz, - bool lazy); + const octave_idx_type *Q, octave_idx_type rst, + octave_idx_type rend, octave_idx_type cst, + octave_idx_type cend, octave_idx_type maxnz, + bool lazy); #endif template <class T> static MArray2<T> dmsolve_extract (const MArray2<T> &m, const octave_idx_type *, - const octave_idx_type *, octave_idx_type r1, - octave_idx_type r2, octave_idx_type c1, - octave_idx_type c2) + const octave_idx_type *, octave_idx_type r1, + octave_idx_type r2, octave_idx_type c1, + octave_idx_type c2) { r2 -= 1; c2 -= 1; @@ -142,21 +142,21 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static MArray2<double> dmsolve_extract (const MArray2<double> &m, const octave_idx_type *, - const octave_idx_type *, octave_idx_type r1, - octave_idx_type r2, octave_idx_type c1, - octave_idx_type c2) + const octave_idx_type *, octave_idx_type r1, + octave_idx_type r2, octave_idx_type c1, + octave_idx_type c2) static MArray2<Complex> dmsolve_extract (const MArray2<Complex> &m, const octave_idx_type *, - const octave_idx_type *, octave_idx_type r1, - octave_idx_type r2, octave_idx_type c1, - octave_idx_type c2) + const octave_idx_type *, octave_idx_type r1, + octave_idx_type r2, octave_idx_type c1, + octave_idx_type c2) #endif template <class T> static void dmsolve_insert (MArray2<T> &a, const MArray2<T> &b, const octave_idx_type *Q, - octave_idx_type r, octave_idx_type c) + octave_idx_type r, octave_idx_type c) { T *ax = a.fortran_vec(); const T *bx = b.fortran_vec(); @@ -168,27 +168,27 @@ octave_idx_type aoff = (c + j) * anr; octave_idx_type boff = j * nr; for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - ax [Q [r + i] + aoff] = bx [i + boff]; - } + { + octave_quit (); + ax [Q [r + i] + aoff] = bx [i + boff]; + } } } #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static void dmsolve_insert (MArray2<double> &a, const MArray2<double> &b, - const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); + const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); static void dmsolve_insert (MArray2<Complex> &a, const MArray2<Complex> &b, - const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); + const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); #endif template <class T> static void dmsolve_insert (MSparse<T> &a, const MSparse<T> &b, const octave_idx_type *Q, - octave_idx_type r, octave_idx_type c) + octave_idx_type r, octave_idx_type c) { octave_idx_type b_rows = b.rows (); octave_idx_type b_cols = b.cols (); @@ -208,7 +208,7 @@ for (octave_idx_type i = c; i < c + b_cols; i++) for (octave_idx_type j = a.xcidx(i); j < a.xcidx(i+1); j++) if (Qinv [a.xridx(j)] < r || Qinv [a.xridx(j)] >= r + b_rows) - nel++; + nel++; OCTAVE_LOCAL_BUFFER (T, X, nr); octave_sort<octave_idx_type> sort; @@ -231,33 +231,33 @@ octave_quit (); for (octave_idx_type j = tmp.xcidx(i); j < tmp.xcidx(i+1); j++) - if (Qinv [tmp.xridx(j)] < r || Qinv [tmp.xridx(j)] >= r + b_rows) - { - X [tmp.xridx(j)] = tmp.xdata(j); - a.xridx(ii++) = tmp.xridx(j); - } + if (Qinv [tmp.xridx(j)] < r || Qinv [tmp.xridx(j)] >= r + b_rows) + { + X [tmp.xridx(j)] = tmp.xdata(j); + a.xridx(ii++) = tmp.xridx(j); + } octave_quit (); for (octave_idx_type j = b.cidx(i-c); j < b.cidx(i-c+1); j++) - { - X [Q [r + b.ridx(j)]] = b.data(j); - a.xridx(ii++) = Q [r + b.ridx(j)]; - } + { + X [Q [r + b.ridx(j)]] = b.data(j); + a.xridx(ii++) = Q [r + b.ridx(j)]; + } sort.sort (ri + a.xcidx (i), ii - a.xcidx (i)); for (octave_idx_type p = a.xcidx (i); p < ii; p++) - a.xdata (p) = X [a.xridx (p)]; + a.xdata (p) = X [a.xridx (p)]; a.xcidx(i+1) = ii; } for (octave_idx_type i = c + b_cols; i < nc; i++) { for (octave_idx_type j = tmp.xcidx(i); j < tmp.cidx(i+1); j++) - { - a.xdata(ii) = tmp.xdata(j); - a.xridx(ii++) = tmp.xridx(j); - } + { + a.xdata(ii) = tmp.xdata(j); + a.xridx(ii++) = tmp.xridx(j); + } a.xcidx(i+1) = ii; } } @@ -265,11 +265,11 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static void dmsolve_insert (MSparse<double> &a, const SparseMatrix &b, - const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); + const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); static void dmsolve_insert (MSparse<Complex> &a, const MSparse<Complex> &b, - const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); + const octave_idx_type *Q, octave_idx_type r, octave_idx_type c); #endif template <class T, class RT> @@ -285,25 +285,25 @@ { octave_idx_type off = j * b_nr; for (octave_idx_type i = 0; i < b_nr; i++) - { - octave_quit (); - Btx [p [i] + off] = Bx [ i + off]; - } + { + octave_quit (); + Btx [p [i] + off] = Bx [ i + off]; + } } } #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static void dmsolve_permute (MArray2<double> &a, const MArray2<double>& b, - const octave_idx_type *p); + const octave_idx_type *p); static void dmsolve_permute (MArray2<Complex> &a, const MArray2<double>& b, - const octave_idx_type *p); + const octave_idx_type *p); static void dmsolve_permute (MArray2<Complex> &a, const MArray2<Complex>& b, - const octave_idx_type *p); + const octave_idx_type *p); #endif template <class T, class RT> @@ -322,18 +322,18 @@ for (octave_idx_type j = 0; j < b_nc; j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) - { - octave_quit (); - octave_idx_type r = p [b.ridx (i)]; - X [r] = b.data (i); - a.xridx(nz++) = p [b.ridx (i)]; - } + { + octave_quit (); + octave_idx_type r = p [b.ridx (i)]; + X [r] = b.data (i); + a.xridx(nz++) = p [b.ridx (i)]; + } sort.sort (ri + a.xcidx (j), nz - a.xcidx (j)); for (octave_idx_type i = a.cidx (j); i < nz; i++) - { - octave_quit (); - a.xdata (i) = X [a.xridx (i)]; - } + { + octave_quit (); + a.xdata (i) = X [a.xridx (i)]; + } a.xcidx(j+1) = nz; } } @@ -341,15 +341,15 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) static void dmsolve_permute (MSparse<double> &a, const MSparse<double>& b, - const octave_idx_type *p); + const octave_idx_type *p); static void dmsolve_permute (MSparse<Complex> &a, const MSparse<double>& b, - const octave_idx_type *p); + const octave_idx_type *p); static void dmsolve_permute (MSparse<Complex> &a, const MSparse<Complex>& b, - const octave_idx_type *p); + const octave_idx_type *p); #endif static void @@ -400,7 +400,7 @@ #endif OCTAVE_LOCAL_BUFFER (octave_idx_type, pinv, nr); for (octave_idx_type i = 0; i < nr; i++) - pinv [p [i]] = i; + pinv [p [i]] = i; RT btmp; dmsolve_permute (btmp, b, pinv); info = 0; @@ -408,66 +408,66 @@ // Leading over-determined block if (dm->rr [2] < nr && dm->cc [3] < nc) - { - ST m = dmsolve_extract (a, pinv, q, dm->rr [2], nr, dm->cc [3], nc, - nnz_remaining, true); - nnz_remaining -= m.nnz(); - RT mtmp = - qrsolve (m, dmsolve_extract (btmp, 0, 0, dm->rr[2], b_nr, 0, - b_nc), info); - dmsolve_insert (retval, mtmp, q, dm->cc [3], 0); - if (dm->rr [2] > 0 && !info) - { - m = dmsolve_extract (a, pinv, q, 0, dm->rr [2], - dm->cc [3], nc, nnz_remaining, true); - nnz_remaining -= m.nnz(); - RT ctmp = dmsolve_extract (btmp, 0, 0, 0, - dm->rr[2], 0, b_nc); - btmp.insert (ctmp - m * mtmp, 0, 0); - } - } + { + ST m = dmsolve_extract (a, pinv, q, dm->rr [2], nr, dm->cc [3], nc, + nnz_remaining, true); + nnz_remaining -= m.nnz(); + RT mtmp = + qrsolve (m, dmsolve_extract (btmp, 0, 0, dm->rr[2], b_nr, 0, + b_nc), info); + dmsolve_insert (retval, mtmp, q, dm->cc [3], 0); + if (dm->rr [2] > 0 && !info) + { + m = dmsolve_extract (a, pinv, q, 0, dm->rr [2], + dm->cc [3], nc, nnz_remaining, true); + nnz_remaining -= m.nnz(); + RT ctmp = dmsolve_extract (btmp, 0, 0, 0, + dm->rr[2], 0, b_nc); + btmp.insert (ctmp - m * mtmp, 0, 0); + } + } // Structurally non-singular blocks // FIXME Should use fine Dulmange-Mendelsohn decomposition here. if (dm->rr [1] < dm->rr [2] && dm->cc [2] < dm->cc [3] && !info) - { - ST m = dmsolve_extract (a, pinv, q, dm->rr [1], dm->rr [2], - dm->cc [2], dm->cc [3], nnz_remaining, false); - nnz_remaining -= m.nnz(); - RT btmp2 = dmsolve_extract (btmp, 0, 0, dm->rr [1], dm->rr [2], - 0, b_nc); - double rcond = 0.0; - MatrixType mtyp (MatrixType::Full); - RT mtmp = m.solve (mtyp, btmp2, info, rcond, - solve_singularity_warning, false); - if (info != 0) - { - info = 0; - mtmp = qrsolve (m, btmp2, info); - } + { + ST m = dmsolve_extract (a, pinv, q, dm->rr [1], dm->rr [2], + dm->cc [2], dm->cc [3], nnz_remaining, false); + nnz_remaining -= m.nnz(); + RT btmp2 = dmsolve_extract (btmp, 0, 0, dm->rr [1], dm->rr [2], + 0, b_nc); + double rcond = 0.0; + MatrixType mtyp (MatrixType::Full); + RT mtmp = m.solve (mtyp, btmp2, info, rcond, + solve_singularity_warning, false); + if (info != 0) + { + info = 0; + mtmp = qrsolve (m, btmp2, info); + } - dmsolve_insert (retval, mtmp, q, dm->cc [2], 0); - if (dm->rr [1] > 0 && !info) - { - m = dmsolve_extract (a, pinv, q, 0, dm->rr [1], dm->cc [2], - dm->cc [3], nnz_remaining, true); - nnz_remaining -= m.nnz(); - RT ctmp = dmsolve_extract (btmp, 0, 0, 0, - dm->rr[1], 0, b_nc); - btmp.insert (ctmp - m * mtmp, 0, 0); - } - } + dmsolve_insert (retval, mtmp, q, dm->cc [2], 0); + if (dm->rr [1] > 0 && !info) + { + m = dmsolve_extract (a, pinv, q, 0, dm->rr [1], dm->cc [2], + dm->cc [3], nnz_remaining, true); + nnz_remaining -= m.nnz(); + RT ctmp = dmsolve_extract (btmp, 0, 0, 0, + dm->rr[1], 0, b_nc); + btmp.insert (ctmp - m * mtmp, 0, 0); + } + } // Trailing under-determined block if (dm->rr [1] > 0 && dm->cc [2] > 0 && !info) - { - ST m = dmsolve_extract (a, pinv, q, 0, dm->rr [1], 0, - dm->cc [2], nnz_remaining, true); - RT mtmp = - qrsolve (m, dmsolve_extract(btmp, 0, 0, 0, dm->rr [1] , 0, - b_nc), info); - dmsolve_insert (retval, mtmp, q, 0, 0); - } + { + ST m = dmsolve_extract (a, pinv, q, 0, dm->rr [1], 0, + dm->cc [2], nnz_remaining, true); + RT mtmp = + qrsolve (m, dmsolve_extract(btmp, 0, 0, 0, dm->rr [1] , 0, + b_nc), info); + dmsolve_insert (retval, mtmp, q, 0, 0); + } CXSPARSE_DNAME (_dfree) (dm); } @@ -480,33 +480,33 @@ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL) extern Matrix dmsolve (const SparseMatrix &a, const Matrix &b, - octave_idx_type &info); + octave_idx_type &info); extern ComplexMatrix dmsolve (const SparseMatrix &a, const ComplexMatrix &b, - octave_idx_type &info); + octave_idx_type &info); extern ComplexMatrix dmsolve (const SparseComplexMatrix &a, const Matrix &b, - octave_idx_type &info); + octave_idx_type &info); extern ComplexMatrix dmsolve (const SparseComplexMatrix &a, const ComplexMatrix &b, - octave_idx_type &info); + octave_idx_type &info); extern SparseMatrix dmsolve (const SparseMatrix &a, const SparseMatrix &b, - octave_idx_type &info); + octave_idx_type &info); extern SparseComplexMatrix dmsolve (const SparseMatrix &a, const SparseComplexMatrix &b, - octave_idx_type &info); + octave_idx_type &info); extern SparseComplexMatrix dmsolve (const SparseComplexMatrix &a, const SparseMatrix &b, - octave_idx_type &info); + octave_idx_type &info); extern SparseComplexMatrix dmsolve (const SparseComplexMatrix &a, const SparseComplexMatrix &b, - octave_idx_type &info); + octave_idx_type &info); #endif
--- a/liboctave/sparse-sort.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/sparse-sort.cc Thu Feb 11 12:23:32 2010 -0500 @@ -39,7 +39,7 @@ bool octave_sparse_sidxl_comp (octave_sparse_sort_idxl* i, - octave_sparse_sort_idxl* j) + octave_sparse_sort_idxl* j) { octave_idx_type tmp = i->c - j->c; if (tmp < 0) @@ -55,7 +55,7 @@ // sparse assignments, and this class does that bool octave_idx_vector_comp (octave_idx_vector_sort* i, - octave_idx_vector_sort* j) + octave_idx_vector_sort* j) { return (i->i < j->i); }
--- a/liboctave/sparse-util.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/sparse-util.cc Thu Feb 11 12:23:32 2010 -0500 @@ -41,7 +41,7 @@ SparseCholError (int status, const char *file, int line, const char *message) { (*current_liboctave_warning_handler)("warning %i, at line %i in file %s", - status, line, file); + status, line, file); (*current_liboctave_warning_handler)(message); } @@ -60,59 +60,59 @@ bool sparse_indices_ok (octave_idx_type *r, octave_idx_type *c, - octave_idx_type nrows, octave_idx_type ncols, - octave_idx_type nnz) + octave_idx_type nrows, octave_idx_type ncols, + octave_idx_type nnz) { if (nnz > 0) { if (c[0] != 0) - { - (*current_liboctave_error_handler) - ("invalid sparse matrix: cidx[0] must be zero"); - return false; - } + { + (*current_liboctave_error_handler) + ("invalid sparse matrix: cidx[0] must be zero"); + return false; + } octave_idx_type jold = 0; for (octave_idx_type j = 1; j < ncols+1; j++) - { - if (c[j] < c[j-1]) - { - (*current_liboctave_error_handler) - ("invalid sparse matrix: cidx elements must appear in ascending order"); - return false; - } + { + if (c[j] < c[j-1]) + { + (*current_liboctave_error_handler) + ("invalid sparse matrix: cidx elements must appear in ascending order"); + return false; + } - if (c[j] > nnz) - { - (*current_liboctave_error_handler) - ("invalid sparse matrix: cidx[%d] = %d exceeds number of nonzero elements", j, c[j]+1); - return false; - } + if (c[j] > nnz) + { + (*current_liboctave_error_handler) + ("invalid sparse matrix: cidx[%d] = %d exceeds number of nonzero elements", j, c[j]+1); + return false; + } - if (c[j] != jold) - { - for (octave_idx_type i = jold+1; i < c[j]; i++) - { - if (r[i] < r[i-1]) - { - (*current_liboctave_error_handler) - ("invalid sparse matrix: ridx elements must appear in ascending order for each column"); - return false; - } + if (c[j] != jold) + { + for (octave_idx_type i = jold+1; i < c[j]; i++) + { + if (r[i] < r[i-1]) + { + (*current_liboctave_error_handler) + ("invalid sparse matrix: ridx elements must appear in ascending order for each column"); + return false; + } - if (r[i] >= nrows) - { - (*current_liboctave_error_handler) - ("invalid sparse matrix: ridx[%d] = %d out of range", - i, r[i]+1); - return false; - } - } + if (r[i] >= nrows) + { + (*current_liboctave_error_handler) + ("invalid sparse matrix: ridx[%d] = %d out of range", + i, r[i]+1); + return false; + } + } - jold = c[j]; - } - } + jold = c[j]; + } + } } return true;
--- a/liboctave/str-vec.cc Thu Feb 11 12:16:43 2010 -0500 +++ b/liboctave/str-vec.cc Thu Feb 11 12:23:32 2010 -0500 @@ -123,12 +123,12 @@ octave_idx_type k = 0; for (octave_idx_type i = 1; i < len; i++) - if (elem(i) != elem(k)) - if (++k != i) - elem(k) = elem(i); + if (elem(i) != elem(k)) + if (++k != i) + elem(k) = elem(i); if (len != ++k) - resize (k); + resize (k); } return *this; @@ -209,7 +209,7 @@ { octave_idx_type name_length = elem (i).length (); if (name_length > max_name_length) - max_name_length = name_length; + max_name_length = name_length; } // Allow at least two spaces between names. @@ -243,21 +243,21 @@ // Print the next row. while (1) - { - std::string nm = elem (count); + { + std::string nm = elem (count); - os << nm; - octave_idx_type name_length = nm.length (); + os << nm; + octave_idx_type name_length = nm.length (); - count += nr; - if (count >= total_names) - break; + count += nr; + if (count >= total_names) + break; - octave_idx_type spaces_to_pad = max_name_length - name_length; - for (octave_idx_type i = 0; i < spaces_to_pad; i++) - os << " "; - pos += max_name_length; - } + octave_idx_type spaces_to_pad = max_name_length - name_length; + for (octave_idx_type i = 0; i < spaces_to_pad; i++) + os << " "; + pos += max_name_length; + } os << "\n"; }