GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
lu.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1996-2018 John W. Eaton
4 Copyright (C) 2009 VZLU Prague
5 
6 This file is part of Octave.
7 
8 Octave is free software: you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12 
13 Octave is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17 
18 You should have received a copy of the GNU General Public License
19 along with Octave; see the file COPYING. If not, see
20 <https://www.gnu.org/licenses/>.
21 
22 */
23 
24 #if defined (HAVE_CONFIG_H)
25 # include "config.h"
26 #endif
27 
28 #include <algorithm>
29 
30 #include "CColVector.h"
31 #include "CMatrix.h"
32 #include "PermMatrix.h"
33 #include "dColVector.h"
34 #include "dMatrix.h"
35 #include "fCColVector.h"
36 #include "fCMatrix.h"
37 #include "fColVector.h"
38 #include "fMatrix.h"
39 #include "lo-error.h"
40 #include "lo-lapack-proto.h"
41 #include "lo-qrupdate-proto.h"
42 #include "lu.h"
43 #include "oct-locbuf.h"
44 
45 namespace octave
46 {
47  namespace math
48  {
49  // FIXME: PermMatrix::col_perm_vec returns Array<octave_idx_type>
50  // but ipvt is an Array<octave_f77_int_type>. This could cause
51  // trouble for large arrays if octave_f77_int_type is 32-bits but
52  // octave_idx_type is 64. Since this constructor is called from
53  // Fluupdate, it could be given values that are out of range. We
54  // should ensure that the values are within range here.
55 
56  template <typename T>
57  lu<T>::lu (const T& l, const T& u, const PermMatrix& p)
58  : a_fact (u), l_fact (l), ipvt (p.transpose ().col_perm_vec ())
59  {
60  if (l.columns () != u.rows ())
61  (*current_liboctave_error_handler) ("lu: dimension mismatch");
62  }
63 
64  template <typename T>
65  bool
66  lu<T>::packed (void) const
67  {
68  return l_fact.dims () == dim_vector ();
69  }
70 
71  template <typename T>
72  void
74  {
75  if (packed ())
76  {
77  l_fact = L ();
78  a_fact = U (); // FIXME: sub-optimal
79 
80  // FIXME: getp returns Array<octave_idx_type> but ipvt is
81  // Array<octave_f77_int_type>. However, getp produces its
82  // result from a valid ipvt array so validation should not be
83  // necessary. OTOH, it might be better to have a version of
84  // getp that doesn't cause us to convert from
85  // Array<octave_f77_int_type> to Array<octave_idx_type> and
86  // back again.
87 
88  ipvt = getp ();
89  }
90  }
91 
92  template <typename T>
93  T
94  lu<T>::L (void) const
95  {
96  if (packed ())
97  {
98  octave_idx_type a_nr = a_fact.rows ();
99  octave_idx_type a_nc = a_fact.columns ();
100  octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc);
101 
102  T l (a_nr, mn, ELT_T (0.0));
103 
104  for (octave_idx_type i = 0; i < a_nr; i++)
105  {
106  if (i < a_nc)
107  l.xelem (i, i) = 1.0;
108 
109  for (octave_idx_type j = 0; j < (i < a_nc ? i : a_nc); j++)
110  l.xelem (i, j) = a_fact.xelem (i, j);
111  }
112 
113  return l;
114  }
115  else
116  return l_fact;
117  }
118 
119  template <typename T>
120  T
121  lu<T>::U (void) const
122  {
123  if (packed ())
124  {
125  octave_idx_type a_nr = a_fact.rows ();
126  octave_idx_type a_nc = a_fact.columns ();
127  octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc);
128 
129  T u (mn, a_nc, ELT_T (0.0));
130 
131  for (octave_idx_type i = 0; i < mn; i++)
132  {
133  for (octave_idx_type j = i; j < a_nc; j++)
134  u.xelem (i, j) = a_fact.xelem (i, j);
135  }
136 
137  return u;
138  }
139  else
140  return a_fact;
141  }
142 
143  template <typename T>
144  T
145  lu<T>::Y (void) const
146  {
147  if (! packed ())
148  (*current_liboctave_error_handler)
149  ("lu: Y () not implemented for unpacked form");
150 
151  return a_fact;
152  }
153 
154  template <typename T>
156  lu<T>::getp (void) const
157  {
158  if (packed ())
159  {
160  octave_idx_type a_nr = a_fact.rows ();
161 
163 
164  for (octave_idx_type i = 0; i < a_nr; i++)
165  pvt.xelem (i) = i;
166 
167  for (octave_idx_type i = 0; i < ipvt.numel (); i++)
168  {
169  octave_idx_type k = ipvt.xelem (i);
170 
171  if (k != i)
172  {
173  octave_idx_type tmp = pvt.xelem (k);
174  pvt.xelem (k) = pvt.xelem (i);
175  pvt.xelem (i) = tmp;
176  }
177  }
178 
179  return pvt;
180  }
181  else
182  return ipvt;
183  }
184 
185  template <typename T>
186  PermMatrix
187  lu<T>::P (void) const
188  {
189  return PermMatrix (getp (), false);
190  }
191 
192  template <typename T>
194  lu<T>::P_vec (void) const
195  {
196  octave_idx_type a_nr = a_fact.rows ();
197 
198  ColumnVector p (a_nr);
199 
200  Array<octave_idx_type> pvt = getp ();
201 
202  for (octave_idx_type i = 0; i < a_nr; i++)
203  p.xelem (i) = static_cast<double> (pvt.xelem (i) + 1);
204 
205  return p;
206  }
207 
208  template <typename T>
209  bool
210  lu<T>::regular (void) const
211  {
212  bool retval = true;
213 
214  octave_idx_type k = std::min (a_fact.rows (), a_fact.columns ());
215 
216  for (octave_idx_type i = 0; i < k; i++)
217  {
218  if (a_fact(i, i) == ELT_T ())
219  {
220  retval = false;
221  break;
222  }
223  }
224 
225  return retval;
226  }
227 
228 #if ! defined (HAVE_QRUPDATE_LUU)
229 
230  template <typename T>
231  void
232  lu<T>::update (const VT&, const VT&)
233  {
234  (*current_liboctave_error_handler)
235  ("luupdate: support for qrupdate with LU updates "
236  "was unavailable or disabled when liboctave was built");
237  }
238 
239  template <typename T>
240  void
241  lu<T>::update (const T&, const T&)
242  {
243  (*current_liboctave_error_handler)
244  ("luupdate: support for qrupdate with LU updates "
245  "was unavailable or disabled when liboctave was built");
246  }
247 
248  template <typename T>
249  void
250  lu<T>::update_piv (const VT&, const VT&)
251  {
252  (*current_liboctave_error_handler)
253  ("luupdate: support for qrupdate with LU updates "
254  "was unavailable or disabled when liboctave was built");
255  }
256 
257  template <typename T>
258  void
259  lu<T>::update_piv (const T&, const T&)
260  {
261  (*current_liboctave_error_handler)
262  ("luupdate: support for qrupdate with LU updates "
263  "was unavailable or disabled when liboctave was built");
264  }
265 
266 #endif
267 
268  // Specializations.
269 
270  template <>
272  {
273  F77_INT a_nr = to_f77_int (a.rows ());
274  F77_INT a_nc = to_f77_int (a.columns ());
275  F77_INT mn = (a_nr < a_nc ? a_nr : a_nc);
276 
277  ipvt.resize (dim_vector (mn, 1));
278  F77_INT *pipvt = ipvt.fortran_vec ();
279 
280  a_fact = a;
281  double *tmp_data = a_fact.fortran_vec ();
282 
283  F77_INT info = 0;
284 
285  F77_XFCN (dgetrf, DGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info));
286 
287  for (F77_INT i = 0; i < mn; i++)
288  pipvt[i] -= 1;
289  }
290 
291 #if defined (HAVE_QRUPDATE_LUU)
292 
293  template <>
294  void
296  {
297  if (packed ())
298  unpack ();
299 
300  Matrix& l = l_fact;
301  Matrix& r = a_fact;
302 
303  F77_INT m = to_f77_int (l.rows ());
304  F77_INT n = to_f77_int (r.columns ());
305  F77_INT k = to_f77_int (l.columns ());
306 
307  F77_INT u_nel = to_f77_int (u.numel ());
308  F77_INT v_nel = to_f77_int (v.numel ());
309 
310  if (u_nel != m || v_nel != n)
311  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
312 
313  ColumnVector utmp = u;
314  ColumnVector vtmp = v;
315  F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (),
316  k, utmp.fortran_vec (), vtmp.fortran_vec ()));
317  }
318 
319  template <>
320  void
321  lu<Matrix>::update (const Matrix& u, const Matrix& v)
322  {
323  if (packed ())
324  unpack ();
325 
326  Matrix& l = l_fact;
327  Matrix& r = a_fact;
328 
329  F77_INT m = to_f77_int (l.rows ());
330  F77_INT n = to_f77_int (r.columns ());
331  F77_INT k = to_f77_int (l.columns ());
332 
333  F77_INT u_nr = to_f77_int (u.rows ());
334  F77_INT u_nc = to_f77_int (u.columns ());
335 
336  F77_INT v_nr = to_f77_int (v.rows ());
337  F77_INT v_nc = to_f77_int (v.columns ());
338 
339  if (u_nr != m || v_nr != n || u_nc != v_nc)
340  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
341 
342  for (volatile F77_INT i = 0; i < u_nc; i++)
343  {
344  ColumnVector utmp = u.column (i);
345  ColumnVector vtmp = v.column (i);
346  F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (),
347  m, r.fortran_vec (), k,
348  utmp.fortran_vec (), vtmp.fortran_vec ()));
349  }
350  }
351 
352  template <>
353  void
355  {
356  if (packed ())
357  unpack ();
358 
359  Matrix& l = l_fact;
360  Matrix& r = a_fact;
361 
362  F77_INT m = to_f77_int (l.rows ());
363  F77_INT n = to_f77_int (r.columns ());
364  F77_INT k = to_f77_int (l.columns ());
365 
366  F77_INT u_nel = to_f77_int (u.numel ());
367  F77_INT v_nel = to_f77_int (v.numel ());
368 
369  if (u_nel != m || v_nel != n)
370  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
371 
372  ColumnVector utmp = u;
373  ColumnVector vtmp = v;
374  OCTAVE_LOCAL_BUFFER (double, w, m);
375  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
376  F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (),
377  m, r.fortran_vec (), k,
378  ipvt.fortran_vec (),
379  utmp.data (), vtmp.data (), w));
380  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
381  }
382 
383  template <>
384  void
386  {
387  if (packed ())
388  unpack ();
389 
390  Matrix& l = l_fact;
391  Matrix& r = a_fact;
392 
393  F77_INT m = to_f77_int (l.rows ());
394  F77_INT n = to_f77_int (r.columns ());
395  F77_INT k = to_f77_int (l.columns ());
396 
397  F77_INT u_nr = to_f77_int (u.rows ());
398  F77_INT u_nc = to_f77_int (u.columns ());
399 
400  F77_INT v_nr = to_f77_int (v.rows ());
401  F77_INT v_nc = to_f77_int (v.columns ());
402 
403  if (u_nr != m || v_nr != n || u_nc != v_nc)
404  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
405 
406  OCTAVE_LOCAL_BUFFER (double, w, m);
407  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
408  for (volatile F77_INT i = 0; i < u_nc; i++)
409  {
410  ColumnVector utmp = u.column (i);
411  ColumnVector vtmp = v.column (i);
412  F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (),
413  m, r.fortran_vec (), k,
414  ipvt.fortran_vec (),
415  utmp.data (), vtmp.data (), w));
416  }
417  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
418  }
419 
420 #endif
421 
422  template <>
424  {
425  F77_INT a_nr = to_f77_int (a.rows ());
426  F77_INT a_nc = to_f77_int (a.columns ());
427  F77_INT mn = (a_nr < a_nc ? a_nr : a_nc);
428 
429  ipvt.resize (dim_vector (mn, 1));
430  F77_INT *pipvt = ipvt.fortran_vec ();
431 
432  a_fact = a;
433  float *tmp_data = a_fact.fortran_vec ();
434 
435  F77_INT info = 0;
436 
437  F77_XFCN (sgetrf, SGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info));
438 
439  for (F77_INT i = 0; i < mn; i++)
440  pipvt[i] -= 1;
441  }
442 
443 #if defined (HAVE_QRUPDATE_LUU)
444 
445  template <>
446  void
448  const FloatColumnVector& v)
449  {
450  if (packed ())
451  unpack ();
452 
453  FloatMatrix& l = l_fact;
454  FloatMatrix& r = a_fact;
455 
456  F77_INT m = to_f77_int (l.rows ());
457  F77_INT n = to_f77_int (r.columns ());
458  F77_INT k = to_f77_int (l.columns ());
459 
460  F77_INT u_nel = to_f77_int (u.numel ());
461  F77_INT v_nel = to_f77_int (v.numel ());
462 
463  if (u_nel != m || v_nel != n)
464  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
465 
466  FloatColumnVector utmp = u;
467  FloatColumnVector vtmp = v;
468  F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (),
469  m, r.fortran_vec (), k,
470  utmp.fortran_vec (), vtmp.fortran_vec ()));
471  }
472 
473  template <>
474  void
476  {
477  if (packed ())
478  unpack ();
479 
480  FloatMatrix& l = l_fact;
481  FloatMatrix& r = a_fact;
482 
483  F77_INT m = to_f77_int (l.rows ());
484  F77_INT n = to_f77_int (r.columns ());
485  F77_INT k = to_f77_int (l.columns ());
486 
487  F77_INT u_nr = to_f77_int (u.rows ());
488  F77_INT u_nc = to_f77_int (u.columns ());
489 
490  F77_INT v_nr = to_f77_int (v.rows ());
491  F77_INT v_nc = to_f77_int (v.columns ());
492 
493  if (u_nr != m || v_nr != n || u_nc != v_nc)
494  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
495 
496  for (volatile F77_INT i = 0; i < u_nc; i++)
497  {
498  FloatColumnVector utmp = u.column (i);
499  FloatColumnVector vtmp = v.column (i);
500  F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (),
501  m, r.fortran_vec (), k,
502  utmp.fortran_vec (), vtmp.fortran_vec ()));
503  }
504  }
505 
506  template <>
507  void
509  const FloatColumnVector& v)
510  {
511  if (packed ())
512  unpack ();
513 
514  FloatMatrix& l = l_fact;
515  FloatMatrix& r = a_fact;
516 
517  F77_INT m = to_f77_int (l.rows ());
518  F77_INT n = to_f77_int (r.columns ());
519  F77_INT k = to_f77_int (l.columns ());
520 
521  F77_INT u_nel = to_f77_int (u.numel ());
522  F77_INT v_nel = to_f77_int (v.numel ());
523 
524  if (u_nel != m || v_nel != n)
525  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
526 
527  FloatColumnVector utmp = u;
528  FloatColumnVector vtmp = v;
529  OCTAVE_LOCAL_BUFFER (float, w, m);
530  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
531  F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (),
532  m, r.fortran_vec (), k,
533  ipvt.fortran_vec (),
534  utmp.data (), vtmp.data (), w));
535  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
536  }
537 
538  template <>
539  void
541  {
542  if (packed ())
543  unpack ();
544 
545  FloatMatrix& l = l_fact;
546  FloatMatrix& r = a_fact;
547 
548  F77_INT m = to_f77_int (l.rows ());
549  F77_INT n = to_f77_int (r.columns ());
550  F77_INT k = to_f77_int (l.columns ());
551 
552  F77_INT u_nr = to_f77_int (u.rows ());
553  F77_INT u_nc = to_f77_int (u.columns ());
554 
555  F77_INT v_nr = to_f77_int (v.rows ());
556  F77_INT v_nc = to_f77_int (v.columns ());
557 
558  if (u_nr != m || v_nr != n || u_nc != v_nc)
559  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
560 
561  OCTAVE_LOCAL_BUFFER (float, w, m);
562  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
563  for (volatile F77_INT i = 0; i < u_nc; i++)
564  {
565  FloatColumnVector utmp = u.column (i);
566  FloatColumnVector vtmp = v.column (i);
567  F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (),
568  m, r.fortran_vec (), k,
569  ipvt.fortran_vec (),
570  utmp.data (), vtmp.data (), w));
571  }
572  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
573  }
574 
575 #endif
576 
577  template <>
579  {
580  F77_INT a_nr = to_f77_int (a.rows ());
581  F77_INT a_nc = to_f77_int (a.columns ());
582  F77_INT mn = (a_nr < a_nc ? a_nr : a_nc);
583 
584  ipvt.resize (dim_vector (mn, 1));
585  F77_INT *pipvt = ipvt.fortran_vec ();
586 
587  a_fact = a;
588  Complex *tmp_data = a_fact.fortran_vec ();
589 
590  F77_INT info = 0;
591 
592  F77_XFCN (zgetrf, ZGETRF, (a_nr, a_nc, F77_DBLE_CMPLX_ARG (tmp_data),
593  a_nr, pipvt, info));
594 
595  for (F77_INT i = 0; i < mn; i++)
596  pipvt[i] -= 1;
597  }
598 
599 #if defined (HAVE_QRUPDATE_LUU)
600 
601  template <>
602  void
604  const ComplexColumnVector& v)
605  {
606  if (packed ())
607  unpack ();
608 
609  ComplexMatrix& l = l_fact;
610  ComplexMatrix& r = a_fact;
611 
612  F77_INT m = to_f77_int (l.rows ());
613  F77_INT n = to_f77_int (r.columns ());
614  F77_INT k = to_f77_int (l.columns ());
615 
616  F77_INT u_nel = to_f77_int (u.numel ());
617  F77_INT v_nel = to_f77_int (v.numel ());
618 
619  if (u_nel != m || v_nel != n)
620  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
621 
622  ComplexColumnVector utmp = u;
623  ComplexColumnVector vtmp = v;
624  F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m,
626  F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()),
627  F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ())));
628  }
629 
630  template <>
631  void
633  {
634  if (packed ())
635  unpack ();
636 
637  ComplexMatrix& l = l_fact;
638  ComplexMatrix& r = a_fact;
639 
640  F77_INT m = to_f77_int (l.rows ());
641  F77_INT n = to_f77_int (r.columns ());
642  F77_INT k = to_f77_int (l.columns ());
643 
644  F77_INT u_nr = to_f77_int (u.rows ());
645  F77_INT u_nc = to_f77_int (u.columns ());
646 
647  F77_INT v_nr = to_f77_int (v.rows ());
648  F77_INT v_nc = to_f77_int (v.columns ());
649 
650  if (u_nr != m || v_nr != n || u_nc != v_nc)
651  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
652 
653  for (volatile F77_INT i = 0; i < u_nc; i++)
654  {
655  ComplexColumnVector utmp = u.column (i);
656  ComplexColumnVector vtmp = v.column (i);
657  F77_XFCN (zlu1up, ZLU1UP, (m, n,
660  k,
662  F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ())));
663  }
664  }
665 
666  template <>
667  void
669  const ComplexColumnVector& v)
670  {
671  if (packed ())
672  unpack ();
673 
674  ComplexMatrix& l = l_fact;
675  ComplexMatrix& r = a_fact;
676 
677  F77_INT m = to_f77_int (l.rows ());
678  F77_INT n = to_f77_int (r.columns ());
679  F77_INT k = to_f77_int (l.columns ());
680 
681  F77_INT u_nel = to_f77_int (u.numel ());
682  F77_INT v_nel = to_f77_int (v.numel ());
683 
684  if (u_nel != m || v_nel != n)
685  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
686 
687  ComplexColumnVector utmp = u;
688  ComplexColumnVector vtmp = v;
690  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
691  F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()),
692  m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k,
693  ipvt.fortran_vec (),
694  F77_CONST_DBLE_CMPLX_ARG (utmp.data ()),
695  F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()),
696  F77_DBLE_CMPLX_ARG (w)));
697  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
698  }
699 
700  template <>
701  void
703  const ComplexMatrix& v)
704  {
705  if (packed ())
706  unpack ();
707 
708  ComplexMatrix& l = l_fact;
709  ComplexMatrix& r = a_fact;
710 
711  F77_INT m = to_f77_int (l.rows ());
712  F77_INT n = to_f77_int (r.columns ());
713  F77_INT k = to_f77_int (l.columns ());
714 
715  F77_INT u_nr = to_f77_int (u.rows ());
716  F77_INT u_nc = to_f77_int (u.columns ());
717 
718  F77_INT v_nr = to_f77_int (v.rows ());
719  F77_INT v_nc = to_f77_int (v.columns ());
720 
721  if (u_nr != m || v_nr != n || u_nc != v_nc)
722  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
723 
725  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
726  for (volatile F77_INT i = 0; i < u_nc; i++)
727  {
728  ComplexColumnVector utmp = u.column (i);
729  ComplexColumnVector vtmp = v.column (i);
730  F77_XFCN (zlup1up, ZLUP1UP, (m, n,
732  m,
734  k, ipvt.fortran_vec (),
735  F77_CONST_DBLE_CMPLX_ARG (utmp.data ()),
736  F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()),
737  F77_DBLE_CMPLX_ARG (w)));
738  }
739  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
740  }
741 
742 #endif
743 
744  template <>
746  {
747  F77_INT a_nr = to_f77_int (a.rows ());
748  F77_INT a_nc = to_f77_int (a.columns ());
749  F77_INT mn = (a_nr < a_nc ? a_nr : a_nc);
750 
751  ipvt.resize (dim_vector (mn, 1));
752  F77_INT *pipvt = ipvt.fortran_vec ();
753 
754  a_fact = a;
755  FloatComplex *tmp_data = a_fact.fortran_vec ();
756 
757  F77_INT info = 0;
758 
759  F77_XFCN (cgetrf, CGETRF, (a_nr, a_nc, F77_CMPLX_ARG (tmp_data), a_nr,
760  pipvt, info));
761 
762  for (F77_INT i = 0; i < mn; i++)
763  pipvt[i] -= 1;
764  }
765 
766 #if defined (HAVE_QRUPDATE_LUU)
767 
768  template <>
769  void
771  const FloatComplexColumnVector& v)
772  {
773  if (packed ())
774  unpack ();
775 
776  FloatComplexMatrix& l = l_fact;
777  FloatComplexMatrix& r = a_fact;
778 
779  F77_INT m = to_f77_int (l.rows ());
780  F77_INT n = to_f77_int (r.columns ());
781  F77_INT k = to_f77_int (l.columns ());
782 
783  F77_INT u_nel = to_f77_int (u.numel ());
784  F77_INT v_nel = to_f77_int (v.numel ());
785 
786  if (u_nel != m || v_nel != n)
787  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
788 
790  FloatComplexColumnVector vtmp = v;
791  F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m,
792  F77_CMPLX_ARG (r.fortran_vec ()), k,
793  F77_CMPLX_ARG (utmp.fortran_vec ()),
794  F77_CMPLX_ARG (vtmp.fortran_vec ())));
795  }
796 
797  template <>
798  void
800  const FloatComplexMatrix& v)
801  {
802  if (packed ())
803  unpack ();
804 
805  FloatComplexMatrix& l = l_fact;
806  FloatComplexMatrix& r = a_fact;
807 
808  F77_INT m = to_f77_int (l.rows ());
809  F77_INT n = to_f77_int (r.columns ());
810  F77_INT k = to_f77_int (l.columns ());
811 
812  F77_INT u_nr = to_f77_int (u.rows ());
813  F77_INT u_nc = to_f77_int (u.columns ());
814 
815  F77_INT v_nr = to_f77_int (v.rows ());
816  F77_INT v_nc = to_f77_int (v.columns ());
817 
818  if (u_nr != m || v_nr != n || u_nc != v_nc)
819  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
820 
821  for (volatile F77_INT i = 0; i < u_nc; i++)
822  {
823  FloatComplexColumnVector utmp = u.column (i);
824  FloatComplexColumnVector vtmp = v.column (i);
825  F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()),
826  m, F77_CMPLX_ARG (r.fortran_vec ()), k,
827  F77_CMPLX_ARG (utmp.fortran_vec ()),
828  F77_CMPLX_ARG (vtmp.fortran_vec ())));
829  }
830  }
831 
832  template <>
833  void
835  const FloatComplexColumnVector& v)
836  {
837  if (packed ())
838  unpack ();
839 
840  FloatComplexMatrix& l = l_fact;
841  FloatComplexMatrix& r = a_fact;
842 
843  F77_INT m = to_f77_int (l.rows ());
844  F77_INT n = to_f77_int (r.columns ());
845  F77_INT k = to_f77_int (l.columns ());
846 
847  F77_INT u_nel = to_f77_int (u.numel ());
848  F77_INT v_nel = to_f77_int (v.numel ());
849 
850  if (u_nel != m || v_nel != n)
851  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
852 
854  FloatComplexColumnVector vtmp = v;
856  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
857  F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()),
858  m, F77_CMPLX_ARG (r.fortran_vec ()), k,
859  ipvt.fortran_vec (),
860  F77_CONST_CMPLX_ARG (utmp.data ()),
861  F77_CONST_CMPLX_ARG (vtmp.data ()),
862  F77_CMPLX_ARG (w)));
863  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
864  }
865 
866  template <>
867  void
869  const FloatComplexMatrix& v)
870  {
871  if (packed ())
872  unpack ();
873 
874  FloatComplexMatrix& l = l_fact;
875  FloatComplexMatrix& r = a_fact;
876 
877  F77_INT m = to_f77_int (l.rows ());
878  F77_INT n = to_f77_int (r.columns ());
879  F77_INT k = to_f77_int (l.columns ());
880 
881  F77_INT u_nr = to_f77_int (u.rows ());
882  F77_INT u_nc = to_f77_int (u.columns ());
883 
884  F77_INT v_nr = to_f77_int (v.rows ());
885  F77_INT v_nc = to_f77_int (v.columns ());
886 
887  if (u_nr != m || v_nr != n || u_nc != v_nc)
888  (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
889 
891  for (F77_INT i = 0; i < m; i++) ipvt(i) += 1; // increment
892  for (volatile F77_INT i = 0; i < u_nc; i++)
893  {
894  FloatComplexColumnVector utmp = u.column (i);
895  FloatComplexColumnVector vtmp = v.column (i);
896  F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()),
897  m, F77_CMPLX_ARG (r.fortran_vec ()), k,
898  ipvt.fortran_vec (),
899  F77_CONST_CMPLX_ARG (utmp.data ()),
900  F77_CONST_CMPLX_ARG (vtmp.data ()),
901  F77_CMPLX_ARG (w)));
902  }
903  for (F77_INT i = 0; i < m; i++) ipvt(i) -= 1; // decrement
904  }
905 
906 #endif
907 
908  // Instantiations we need.
909 
910  template class lu<Matrix>;
911 
912  template class lu<FloatMatrix>;
913 
914  template class lu<ComplexMatrix>;
915 
916  template class lu<FloatComplexMatrix>;
917  }
918 }
octave_idx_type rows(void) const
Definition: Array.h:404
const T * data(void) const
Definition: Array.h:582
PermMatrix P(void) const
Definition: lu.cc:187
OCTAVE_NORETURN liboctave_error_handler current_liboctave_error_handler
Definition: lo-error.c:38
#define F77_DBLE_CMPLX_ARG(x)
Definition: f77-fcn.h:315
for large enough k
Definition: lu.cc:617
const T * fortran_vec(void) const
Definition: Array.h:584
static void transpose(octave_idx_type N, const octave_idx_type *ridx, const octave_idx_type *cidx, octave_idx_type *ridx2, octave_idx_type *cidx2)
Definition: symrcm.cc:386
Definition: mx-defs.h:77
octave_idx_type columns(void) const
Definition: Array.h:413
u
Definition: lu.cc:138
#define F77_XFCN(f, F, args)
Definition: f77-fcn.h:41
octave_idx_type a_nc
Definition: sylvester.cc:74
Array< octave_idx_type > getp(void) const
Definition: lu.cc:156
calling an anonymous function involves an overhead quite comparable to the overhead of an m file function Passing a handle to a built in function is because the interpreter is not involved in the internal loop For a
Definition: cellfun.cc:400
octave_idx_type a_nr
Definition: sylvester.cc:73
T L(void) const
Definition: lu.cc:94
std::complex< double > w(std::complex< double > z, double relerr=0)
double tmp
Definition: data.cc:6252
octave_value retval
Definition: data.cc:6246
T U(void) const
Definition: lu.cc:121
ColumnVector column(octave_idx_type i) const
Definition: dMatrix.cc:421
void update_piv(const VT &u, const VT &v)
bool packed(void) const
Definition: lu.cc:66
Definition: dMatrix.h:36
T & xelem(octave_idx_type n)
Definition: Array.h:458
bool regular(void) const
Definition: lu.cc:210
T Y(void) const
Definition: lu.cc:145
lu(void)
Definition: lu.h:47
#define F77_CMPLX_ARG(x)
Definition: f77-fcn.h:309
#define F77_CONST_DBLE_CMPLX_ARG(x)
Definition: f77-fcn.h:318
T::element_type ELT_T
Definition: lu.h:45
octave_f77_int_type F77_INT
Definition: f77-fcn.h:305
p
Definition: lu.cc:138
FloatComplexColumnVector column(octave_idx_type i) const
Definition: fCMatrix.cc:710
ColumnVector P_vec(void) const
Definition: lu.cc:194
#define OCTAVE_LOCAL_BUFFER(T, buf, size)
Definition: oct-locbuf.h:41
void update(const VT &u, const VT &v)
#define F77_CONST_CMPLX_ARG(x)
Definition: f77-fcn.h:312
ComplexColumnVector column(octave_idx_type i) const
Definition: CMatrix.cc:707
for i
Definition: data.cc:5264
std::complex< float > FloatComplex
Definition: oct-cmplx.h:32
void unpack(void)
Definition: lu.cc:73
std::complex< double > Complex
Definition: oct-cmplx.h:31
FloatColumnVector column(octave_idx_type i) const
Definition: fMatrix.cc:427
octave_idx_type numel(void) const
Number of elements in the array.
Definition: Array.h:366
Vector representing the dimensions (size) of an Array.
Definition: dim-vector.h:87
charNDArray min(char d, const charNDArray &m)
Definition: chNDArray.cc:204