Mercurial > octave
view liboctave/numeric/lu.cc @ 30564:796f54d4ddbf stable
update Octave Project Developers copyright for the new year
In files that have the "Octave Project Developers" copyright notice,
update for 2021.
In all .txi and .texi files except gpl.txi and gpl.texi in the
doc/liboctave and doc/interpreter directories, change the copyright
to "Octave Project Developers", the same as used for other source
files. Update copyright notices for 2022 (not done since 2019). For
gpl.txi and gpl.texi, change the copyright notice to be "Free Software
Foundation, Inc." and leave the date at 2007 only because this file
only contains the text of the GPL, not anything created by the Octave
Project Developers.
Add Paul Thomas to contributors.in.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Tue, 28 Dec 2021 18:22:40 -0500 |
parents | 51040836259d |
children | e88a07dec498 |
line wrap: on
line source
//////////////////////////////////////////////////////////////////////// // // Copyright (C) 1996-2022 The Octave Project Developers // // See the file COPYRIGHT.md in the top-level directory of this // distribution or <https://octave.org/copyright/>. // // This file is part of Octave. // // Octave is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 3 of the License, or // (at your option) any later version. // // Octave is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Octave; see the file COPYING. If not, see // <https://www.gnu.org/licenses/>. // //////////////////////////////////////////////////////////////////////// #if defined (HAVE_CONFIG_H) # include "config.h" #endif #include <algorithm> #include "CColVector.h" #include "CMatrix.h" #include "PermMatrix.h" #include "dColVector.h" #include "dMatrix.h" #include "fCColVector.h" #include "fCMatrix.h" #include "fColVector.h" #include "fMatrix.h" #include "lo-error.h" #include "lo-lapack-proto.h" #include "lo-qrupdate-proto.h" #include "lu.h" #include "oct-locbuf.h" namespace octave { namespace math { // FIXME: PermMatrix::col_perm_vec returns Array<octave_idx_type> // but m_ipvt is an Array<octave_f77_int_type>. This could cause // trouble for large arrays if octave_f77_int_type is 32-bits but // octave_idx_type is 64. Since this constructor is called from // Fluupdate, it could be given values that are out of range. We // should ensure that the values are within range here. template <typename T> lu<T>::lu (const T& l, const T& u, const PermMatrix& p) : m_a_fact (u), m_L (l), m_ipvt (p.transpose ().col_perm_vec ()) { if (l.columns () != u.rows ()) (*current_liboctave_error_handler) ("lu: dimension mismatch"); } template <typename T> bool lu<T>::packed (void) const { return m_L.dims () == dim_vector (); } template <typename T> void lu<T>::unpack (void) { if (packed ()) { m_L = L (); m_a_fact = U (); // FIXME: sub-optimal // FIXME: getp returns Array<octave_idx_type> but m_ipvt is // Array<octave_f77_int_type>. However, getp produces its // result from a valid m_ipvt array so validation should not be // necessary. OTOH, it might be better to have a version of // getp that doesn't cause us to convert from // Array<octave_f77_int_type> to Array<octave_idx_type> and // back again. m_ipvt = getp (); } } template <typename T> T lu<T>::L (void) const { if (packed ()) { octave_idx_type a_nr = m_a_fact.rows (); octave_idx_type a_nc = m_a_fact.columns (); octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); T l (a_nr, mn, ELT_T (0.0)); for (octave_idx_type i = 0; i < a_nr; i++) { if (i < a_nc) l.xelem (i, i) = 1.0; for (octave_idx_type j = 0; j < (i < a_nc ? i : a_nc); j++) l.xelem (i, j) = m_a_fact.xelem (i, j); } return l; } else return m_L; } template <typename T> T lu<T>::U (void) const { if (packed ()) { octave_idx_type a_nr = m_a_fact.rows (); octave_idx_type a_nc = m_a_fact.columns (); octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); T u (mn, a_nc, ELT_T (0.0)); for (octave_idx_type i = 0; i < mn; i++) { for (octave_idx_type j = i; j < a_nc; j++) u.xelem (i, j) = m_a_fact.xelem (i, j); } return u; } else return m_a_fact; } template <typename T> T lu<T>::Y (void) const { if (! packed ()) (*current_liboctave_error_handler) ("lu: Y () not implemented for unpacked form"); return m_a_fact; } template <typename T> Array<octave_idx_type> lu<T>::getp (void) const { if (packed ()) { octave_idx_type a_nr = m_a_fact.rows (); Array<octave_idx_type> pvt (dim_vector (a_nr, 1)); for (octave_idx_type i = 0; i < a_nr; i++) pvt.xelem (i) = i; for (octave_idx_type i = 0; i < m_ipvt.numel (); i++) { octave_idx_type k = m_ipvt.xelem (i); if (k != i) { octave_idx_type tmp = pvt.xelem (k); pvt.xelem (k) = pvt.xelem (i); pvt.xelem (i) = tmp; } } return pvt; } else return m_ipvt; } template <typename T> PermMatrix lu<T>::P (void) const { return PermMatrix (getp (), false); } template <typename T> ColumnVector lu<T>::P_vec (void) const { octave_idx_type a_nr = m_a_fact.rows (); ColumnVector p (a_nr); Array<octave_idx_type> pvt = getp (); for (octave_idx_type i = 0; i < a_nr; i++) p.xelem (i) = static_cast<double> (pvt.xelem (i) + 1); return p; } template <typename T> bool lu<T>::regular (void) const { bool retval = true; octave_idx_type k = std::min (m_a_fact.rows (), m_a_fact.columns ()); for (octave_idx_type i = 0; i < k; i++) { if (m_a_fact(i, i) == ELT_T ()) { retval = false; break; } } return retval; } #if ! defined (HAVE_QRUPDATE_LUU) template <typename T> void lu<T>::update (const VT&, const VT&) { (*current_liboctave_error_handler) ("luupdate: support for qrupdate with LU updates " "was unavailable or disabled when liboctave was built"); } template <typename T> void lu<T>::update (const T&, const T&) { (*current_liboctave_error_handler) ("luupdate: support for qrupdate with LU updates " "was unavailable or disabled when liboctave was built"); } template <typename T> void lu<T>::update_piv (const VT&, const VT&) { (*current_liboctave_error_handler) ("luupdate: support for qrupdate with LU updates " "was unavailable or disabled when liboctave was built"); } template <typename T> void lu<T>::update_piv (const T&, const T&) { (*current_liboctave_error_handler) ("luupdate: support for qrupdate with LU updates " "was unavailable or disabled when liboctave was built"); } #endif // Specializations. template <> OCTAVE_API lu<Matrix>::lu (const Matrix& a) { F77_INT a_nr = to_f77_int (a.rows ()); F77_INT a_nc = to_f77_int (a.columns ()); F77_INT mn = (a_nr < a_nc ? a_nr : a_nc); m_ipvt.resize (dim_vector (mn, 1)); F77_INT *pipvt = m_ipvt.fortran_vec (); m_a_fact = a; double *tmp_data = m_a_fact.fortran_vec (); F77_INT info = 0; F77_XFCN (dgetrf, DGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); for (F77_INT i = 0; i < mn; i++) pipvt[i] -= 1; } #if defined (HAVE_QRUPDATE_LUU) template <> OCTAVE_API void lu<Matrix>::update (const ColumnVector& u, const ColumnVector& v) { if (packed ()) unpack (); Matrix& l = m_L; Matrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); ColumnVector utmp = u; ColumnVector vtmp = v; F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } template <> OCTAVE_API void lu<Matrix>::update (const Matrix& u, const Matrix& v) { if (packed ()) unpack (); Matrix& l = m_L; Matrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); for (volatile F77_INT i = 0; i < u_nc; i++) { ColumnVector utmp = u.column (i); ColumnVector vtmp = v.column (i); F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } } template <> OCTAVE_API void lu<Matrix>::update_piv (const ColumnVector& u, const ColumnVector& v) { if (packed ()) unpack (); Matrix& l = m_L; Matrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); ColumnVector utmp = u; ColumnVector vtmp = v; OCTAVE_LOCAL_BUFFER (double, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, m_ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } template <> OCTAVE_API void lu<Matrix>::update_piv (const Matrix& u, const Matrix& v) { if (packed ()) unpack (); Matrix& l = m_L; Matrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); OCTAVE_LOCAL_BUFFER (double, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment for (volatile F77_INT i = 0; i < u_nc; i++) { ColumnVector utmp = u.column (i); ColumnVector vtmp = v.column (i); F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, m_ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); } for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } #endif template <> OCTAVE_API lu<FloatMatrix>::lu (const FloatMatrix& a) { F77_INT a_nr = to_f77_int (a.rows ()); F77_INT a_nc = to_f77_int (a.columns ()); F77_INT mn = (a_nr < a_nc ? a_nr : a_nc); m_ipvt.resize (dim_vector (mn, 1)); F77_INT *pipvt = m_ipvt.fortran_vec (); m_a_fact = a; float *tmp_data = m_a_fact.fortran_vec (); F77_INT info = 0; F77_XFCN (sgetrf, SGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); for (F77_INT i = 0; i < mn; i++) pipvt[i] -= 1; } #if defined (HAVE_QRUPDATE_LUU) template <> OCTAVE_API void lu<FloatMatrix>::update (const FloatColumnVector& u, const FloatColumnVector& v) { if (packed ()) unpack (); FloatMatrix& l = m_L; FloatMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); FloatColumnVector utmp = u; FloatColumnVector vtmp = v; F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } template <> OCTAVE_API void lu<FloatMatrix>::update (const FloatMatrix& u, const FloatMatrix& v) { if (packed ()) unpack (); FloatMatrix& l = m_L; FloatMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); for (volatile F77_INT i = 0; i < u_nc; i++) { FloatColumnVector utmp = u.column (i); FloatColumnVector vtmp = v.column (i); F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } } template <> OCTAVE_API void lu<FloatMatrix>::update_piv (const FloatColumnVector& u, const FloatColumnVector& v) { if (packed ()) unpack (); FloatMatrix& l = m_L; FloatMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); FloatColumnVector utmp = u; FloatColumnVector vtmp = v; OCTAVE_LOCAL_BUFFER (float, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, m_ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } template <> OCTAVE_API void lu<FloatMatrix>::update_piv (const FloatMatrix& u, const FloatMatrix& v) { if (packed ()) unpack (); FloatMatrix& l = m_L; FloatMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); OCTAVE_LOCAL_BUFFER (float, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment for (volatile F77_INT i = 0; i < u_nc; i++) { FloatColumnVector utmp = u.column (i); FloatColumnVector vtmp = v.column (i); F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, m_ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); } for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } #endif template <> OCTAVE_API lu<ComplexMatrix>::lu (const ComplexMatrix& a) { F77_INT a_nr = to_f77_int (a.rows ()); F77_INT a_nc = to_f77_int (a.columns ()); F77_INT mn = (a_nr < a_nc ? a_nr : a_nc); m_ipvt.resize (dim_vector (mn, 1)); F77_INT *pipvt = m_ipvt.fortran_vec (); m_a_fact = a; Complex *tmp_data = m_a_fact.fortran_vec (); F77_INT info = 0; F77_XFCN (zgetrf, ZGETRF, (a_nr, a_nc, F77_DBLE_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); for (F77_INT i = 0; i < mn; i++) pipvt[i] -= 1; } #if defined (HAVE_QRUPDATE_LUU) template <> OCTAVE_API void lu<ComplexMatrix>::update (const ComplexColumnVector& u, const ComplexColumnVector& v) { if (packed ()) unpack (); ComplexMatrix& l = m_L; ComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); ComplexColumnVector utmp = u; ComplexColumnVector vtmp = v; F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()))); } template <> OCTAVE_API void lu<ComplexMatrix>::update (const ComplexMatrix& u, const ComplexMatrix& v) { if (packed ()) unpack (); ComplexMatrix& l = m_L; ComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); for (volatile F77_INT i = 0; i < u_nc; i++) { ComplexColumnVector utmp = u.column (i); ComplexColumnVector vtmp = v.column (i); F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()))); } } template <> OCTAVE_API void lu<ComplexMatrix>::update_piv (const ComplexColumnVector& u, const ComplexColumnVector& v) { if (packed ()) unpack (); ComplexMatrix& l = m_L; ComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); ComplexColumnVector utmp = u; ComplexColumnVector vtmp = v; OCTAVE_LOCAL_BUFFER (Complex, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, m_ipvt.fortran_vec (), F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()), F77_DBLE_CMPLX_ARG (w))); for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } template <> OCTAVE_API void lu<ComplexMatrix>::update_piv (const ComplexMatrix& u, const ComplexMatrix& v) { if (packed ()) unpack (); ComplexMatrix& l = m_L; ComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); OCTAVE_LOCAL_BUFFER (Complex, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment for (volatile F77_INT i = 0; i < u_nc; i++) { ComplexColumnVector utmp = u.column (i); ComplexColumnVector vtmp = v.column (i); F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, m_ipvt.fortran_vec (), F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()), F77_DBLE_CMPLX_ARG (w))); } for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } #endif template <> OCTAVE_API lu<FloatComplexMatrix>::lu (const FloatComplexMatrix& a) { F77_INT a_nr = to_f77_int (a.rows ()); F77_INT a_nc = to_f77_int (a.columns ()); F77_INT mn = (a_nr < a_nc ? a_nr : a_nc); m_ipvt.resize (dim_vector (mn, 1)); F77_INT *pipvt = m_ipvt.fortran_vec (); m_a_fact = a; FloatComplex *tmp_data = m_a_fact.fortran_vec (); F77_INT info = 0; F77_XFCN (cgetrf, CGETRF, (a_nr, a_nc, F77_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); for (F77_INT i = 0; i < mn; i++) pipvt[i] -= 1; } #if defined (HAVE_QRUPDATE_LUU) template <> OCTAVE_API void lu<FloatComplexMatrix>::update (const FloatComplexColumnVector& u, const FloatComplexColumnVector& v) { if (packed ()) unpack (); FloatComplexMatrix& l = m_L; FloatComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); FloatComplexColumnVector utmp = u; FloatComplexColumnVector vtmp = v; F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); } template <> OCTAVE_API void lu<FloatComplexMatrix>::update (const FloatComplexMatrix& u, const FloatComplexMatrix& v) { if (packed ()) unpack (); FloatComplexMatrix& l = m_L; FloatComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); for (volatile F77_INT i = 0; i < u_nc; i++) { FloatComplexColumnVector utmp = u.column (i); FloatComplexColumnVector vtmp = v.column (i); F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); } } template <> OCTAVE_API void lu<FloatComplexMatrix>::update_piv (const FloatComplexColumnVector& u, const FloatComplexColumnVector& v) { if (packed ()) unpack (); FloatComplexMatrix& l = m_L; FloatComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nel = to_f77_int (u.numel ()); F77_INT v_nel = to_f77_int (v.numel ()); if (u_nel != m || v_nel != n) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); FloatComplexColumnVector utmp = u; FloatComplexColumnVector vtmp = v; OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, m_ipvt.fortran_vec (), F77_CONST_CMPLX_ARG (utmp.data ()), F77_CONST_CMPLX_ARG (vtmp.data ()), F77_CMPLX_ARG (w))); for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } template <> OCTAVE_API void lu<FloatComplexMatrix>::update_piv (const FloatComplexMatrix& u, const FloatComplexMatrix& v) { if (packed ()) unpack (); FloatComplexMatrix& l = m_L; FloatComplexMatrix& r = m_a_fact; F77_INT m = to_f77_int (l.rows ()); F77_INT n = to_f77_int (r.columns ()); F77_INT k = to_f77_int (l.columns ()); F77_INT u_nr = to_f77_int (u.rows ()); F77_INT u_nc = to_f77_int (u.columns ()); F77_INT v_nr = to_f77_int (v.rows ()); F77_INT v_nc = to_f77_int (v.columns ()); if (u_nr != m || v_nr != n || u_nc != v_nc) (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); for (F77_INT i = 0; i < m; i++) m_ipvt(i) += 1; // increment for (volatile F77_INT i = 0; i < u_nc; i++) { FloatComplexColumnVector utmp = u.column (i); FloatComplexColumnVector vtmp = v.column (i); F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, m_ipvt.fortran_vec (), F77_CONST_CMPLX_ARG (utmp.data ()), F77_CONST_CMPLX_ARG (vtmp.data ()), F77_CMPLX_ARG (w))); } for (F77_INT i = 0; i < m; i++) m_ipvt(i) -= 1; // decrement } #endif // Instantiations we need. template class lu<Matrix>; template class lu<FloatMatrix>; template class lu<ComplexMatrix>; template class lu<FloatComplexMatrix>; } }